\ pong_13.fs \ "Stackbasierte Sprachen", WS0607 \ Author: Konrad Mönks \ Matr.Nr.: 0405715 \ 28.12.06 \ --------------------------------------------------- \ BESONDERHEITEN: \ ---- fast alles ist eine Stack-Operation \ --> postfix-Notation, keine Klammern notwendig \ ---- Variablen sind generell pointer --> pointer-arithmetik \ - create ... allot --> kann als Liste od. Array gesehen werden \ ---- returnstack und lokale Variablen wurden nicht verwendet \ - Keine Syntax Analyse notwendig, nur lexikalische --> schneller \ ---- keine Typ-Überprüfung! --> Verantwortung des Programmierers \ --> fast ausschliesslich signed integer und character wurden verwendet \ - logisches UND etc. ist de facto Bit-Operation \ --> ggf. können arithmetische und logische Ops gemischt werden ( nicht geschehen ) \ - "Funktionen" sind de facto Wörterbuch-Einträge von Wörtern \ --- begin ... while ... repeat \ --> exit an beliebiger Stelle zwischen begin und repeat \ - Parameter-Übergabe bei Funktionen über Stack-Operationen \ --> Reduktion globaler Var. vs. Lesbarkeit \ \ -------------------------------------------------- variable positionx \ moving right ( = 1 ) or left ( = 0 ) variable positiony \ moving down ( = 1 ) or up ( = 0 ) variable pos-club \ position of the club, 1 < pos-club < 13, comp. w. frame variable win \ player wins, iff win == 1 variable lose \ player loses, iff lose == 1 create rborder 13 cells allot \ wining condition: sum of rborder == 0 \ constant char e value up-key \ customize if wanted char d value down-key char q value quit-key \ ------------------ Drawing --------------------------------- : draw-frame ( -- ) \ display frame 0 1 at-xy ." ---------------------------------------------------------" 0 2 at-xy ." |# $ ########################" 0 3 at-xy ." |# $ # #" 0 4 at-xy ." |# $ # Use '" down-key emit ." ' to move down #" 0 5 at-xy ." | $ # Use '" up-key emit ." ' to move up #" 0 6 at-xy ." | $ # Use '" quit-key emit ." ' to quit #" 0 7 at-xy ." | $ # #" 0 8 at-xy ." | $ # #" 0 9 at-xy ." | $ # #" 0 10 at-xy ." | $ # #" 0 11 at-xy ." | $ # #" 0 12 at-xy ." | $ # #" 0 13 at-xy ." | $ # #" 0 14 at-xy ." | $ ########################" 0 15 at-xy ." |-------------------------------------------------------|" 0 16 at-xy ." | | 0 17 at-xy ." ---------------------------------------------------------" ; : draw-club ( -- ) \ draws club on left side according to pos-club 15 2 u+do \ von 1 2 bis 1 14 ." " zeichnen 1 i at-xy ." " loop 3 0 u+do 1 pos-club @ i + at-xy ." #" \ 0 < pos-club < 12 loop ; : move-club-down ( -- ) \ check wether bottom is already reached pos-club @ 12 < if pos-club @ 1+ pos-club ! \ increment pos-club draw-club then ; \ if bottom is reached, do nothing : move-club-up ( -- ) \ check wether top is already reached pos-club @ 2 > if pos-club @ 1- pos-club ! \ decrement pos-club draw-club then ; \ if top is reached, do nothing : bottom-msg ( addr -- ) 2 16 at-xy type ; : move-ball ( oldx oldy newx newy --- newx newy ) 2dup at-xy ." *" 2swap at-xy ." " ; \ ---------------------- move ball -------------------------- : generate-new-position ( oldx oldy -- oldx oldy newx newy ) over \ Stack: oldx oldy oldx dup 29 < positionx @ 1 = and if \ right-line not yet reached AND positionx == 1 --> moving right 1+ else \ right-line is reached OR we are already moving left, i.e. move left 0 positionx ! endif dup 3 > positionx @ 0 = and if \ left-line not yet reached AND positionx == 0 --> moving left 1- else \ left-line is reached OR we are already moving right, i.e. move right 1 positionx ! endif over \ Stack: oldx oldy newx oldy dup 14 < positiony @ 1 = and if \ bottom-line not yet reached AND positiony == 1 --> moving down 1+ else \ bottom-line is reached OR we are already moving up, i.e. move up 0 positiony ! endif dup 2 > positiony @ 0 = and if \ top-line not yet reached AND positiony == 0 --> moving up 1- else \ top-line is reached OR we are already moving down, i.e. move down 1 positiony ! endif ; \ -------------------- initiate variables ------------------ : initiate ( -- newx newy ) 5 5 \ define initial position of ball 1 positiony ! \ start moving down 1 positionx ! \ start moving right 0 win ! \ when win == 1, player wins 0 lose ! \ when lose == 1, player loses 13 0 u+do 1 rborder i cells + ! loop 2 pos-club ! ; \ place club at the top \ ----------- compute win and lose condition --------------------- : compute-win ( -- ) \ win = 1 if player wins 0 \ initiate stack with 0 13 0 u+do rborder i cells + @ + \ Stack: 0 x0 + x1 + ... x12 + loop 0= if 1 win ! else 0 win ! endif ; : check-hit ( -- ) \ check wether right-border is hit; hit-condition: x = 29; stack: ... newx newy over 29 = if \ stack: x y x 29 = dup 0 rborder rot 2 - cells + ! \ x y 0 rborder y 2 - cells + ! \ " 2 - ", cause y is allways >= 2 compute-win then ; : check-lose ( newx newy -- newx newy ) \ check wether ball hits club or not \ lose-condition: x = 3 && \ ( y != pos-club || \ y != pos-club + 1 || \ y != pos-club + 2 || \ y != pos-club + 3 || ) over 3 = if 1 lose ! \ player loses dup pos-club @ = if 0 lose ! \ player wins then dup pos-club @ 1+ = if 0 lose ! \ player wins then dup pos-club @ 2 + = if 0 lose ! \ player wins then \ e.g. x=3 , y=4 --> x=3 , y=5; Ball moves parallel to club, therefore club is broader dup pos-club @ 3 + = if 0 lose ! \ player wins then then ; \ ------------ proceed input ----------------------------- : control ( key -- flag ) case key up-key of move-club-up endof down-key of move-club-down endof quit-key of true exit endof endcase false ; \ ----------- Play one game ------------------------------ : play-game ( startx starty -- startx starty ) \ play one game begin 200 ms \ delay generate-new-position check-hit \ switches win to " 1 " if player wins check-lose \ switches lose to " 1 " if player loses move-ball \ draw new ball, delete old one key? if \ any key pressed ? control if \ " key-quit " was pressed; if not, club was moved by control s" USER INTERRUPT! " bottom-msg exit then then win @ 1 = if s" YOU WIN! " bottom-msg exit then lose @ 1 = until s" YOU LOOSE! " bottom-msg ; \ ----------- MAIN ---------------------------------------- : main ( -- ) draw-frame s" Press any key to start " bottom-msg key drop \ blocks execution begin initiate draw-frame s" Game started. " bottom-msg play-game 1500 ms \ delay to display end-of-game message at-xy ." " \ Stack: <2> newx newy --> delete ball s" Again ? ( y / n ) " bottom-msg key [char] y <> until s" GOODBYE " bottom-msg ; \ [char] compilation 'ccc' -- ; run-time -- c . nimmt den ersten \ ------------------------- EOF ---------------------------------