home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HyperLib 1997 Winter - Disc 1
/
HYPERLIB-1997-Winter-CD1.ISO.7z
/
HYPERLIB-1997-Winter-CD1.ISO
/
オンラインウェア
/
GAME
/
Rhine.sit
/
Rhine
/
Rhiner
< prev
next >
Wrap
Text File
|
1993-06-27
|
10KB
|
261 lines
( rhine.txt 15 Nov. 1988 10:14 PM )
( add color, etc 21 July 1991 9:01 PM )
forget task : task ; 0 28 +md ! ( no echo )
( old style colors )
: BLACK 33 0 2>r ,$ A862 ; ( black _ForeColor )
: WHITE 30 0 2>r ,$ A862 ; ( white _ForeColor )
: RED 205 0 2>r ,$ A862 ; ( red _ForeColor )
: GREEN 341 0 2>r ,$ A862 ; ( green _ForeColor )
: BLUE 409 0 2>r ,$ A862 ; ( blue _ForeColor )
: CYAN 273 0 2>r ,$ A862 ; ( blue-green _ForeColor )
: MAGENTA 137 0 2>r ,$ A862 ; ( purple _ForeColor )
: YELLOW 69 0 2>r ,$ A862 ; ( yellow _ForeColor )
: ?COLOR ( -- f ) ( true if color qd is available )
,s qd ?gestalt IF drop 256 > ELSE 0 THEN ;
: MYID ( -- id ) ?color IF 150 ELSE 130 THEN ;
: 2, ( d -- ) ,$ 24DE ; macro ( move.l [ps]+,[dp]+ )
: 4* ( n -- n*4 ) 2* 2* ; macro
: 8* ( n -- n*8 ) 4* 2* ;
: R+ ( n -- n+r ) ( add the loop index to the number on the stack )
,$ 3017 ,$ D156 ; macro ( move.w [rs],d0 add.w d0,[ps] )
: 2R ( -- d ) ( rstack: d -- d ) ,$ 2D17 ; macro ( move.l [rs],-[ps] )
( time stuff )
variable TLAST 0 tlast ! ( timer )
10 constant DELAY
: TICKS ( -- n ) 364 0 l@ ; ( ticks since reference time )
: TIME ( -- ) ( wait for "delay" number of ticks )
ticks tlast !
BEGIN ticks tlast @ - abs delay > UNTIL ;
( random numbers )
¥ Pick a random number from 0 to n
: SEED ( -- daddr ) ,$ 2d15 126 0 dnegate d+ ;
: RANDOMIZE 524 0 dl@ seed dl! ;
: RANDOM ( n -- n' )
0 >r ,$ A861 r> ( _Random )
swap 32768 */ abs ; ( scale to size from stack )
: 0TO4 ( -- n ) 5 random ;
( pick 5 of each )
variable OFEACH 6 allot ( how many cards of each type )
: OFTHIS ( n -- addr ) ofeach + ;
: @THIS ( n -- n' ) ofthis c@ ;
: DNEW ( -- ) randomize 5 0 DO 5 ofeach r + c! LOOP ;
: PICK ( -- n )
0to4 dup @this IF
dup @this 1- over ofthis c!
ELSE drop pick THEN ;
( fill the deck with 5 of each )
variable CARD ( the current card number )
variable DECK 24 allot deck 26 0 fill
: SHUFFLE ( -- ) dnew 25 0 DO pick deck r + c! LOOP ;
( rectangles )
: RECT ( compile: -- ) ( run: -- addr ) variable 6 allot ;
: !RECT ( t l b r rect -- ) >r swap r 4 + 2! swap r> 2! ;
: RERASE ( rect -- ) a>r ,$ A8A3 ; ( _EraseRect )
: RRFRAME ( cornerh cornerv rect -- )
a>r 2>r ,$ A8B0 ; ( _FrameRoundRect )
: RRERASE ( cornerh cornerv rect -- )
a>r 2>r ,$ A8B2 ; ( _EraseRoundRect )
: RLGRAY ( rect -- ) magenta a>r ( paint a rect gray )
,$ 2055 ( movea.l [a5],a0 )
,$ 4868 ,$ FFE0 ( pea -32[a0] )
,$ A8A5 ; ( _PaintRect )
: ?IN ( h v rect -- flag ) ( true if h,v is in rect at addr )
0 >r rot rot 2>r a>r ,$ A8AD r> ; ( _PtInRect )
( fonts )
: !FONT ( n -- ) >r ,$ A887 ; macro ( _TextFont ) ( set font )
: !FSIZE ( n -- ) >r ,$ A88A ; macro ( _TextSize ) ( set size )
: !FFACE ( n -- ) >r ,$ A888 ; macro ( _TextFace ) ( set face )
: BFONT ( -- ) 3 !font 9 !fsize 1 !fface ; ( set a little bold font )
: LFONT ( -- ) 3 !font 9 !fsize 0 !fface ;
: CFONT ( -- ) 3 !font 9 !fsize 32 !fface ;
( pictures )
: GETPICT ( id -- dhandle ) 0 0 2>r >r ,$ A9BC 2r> ; ( _GetPict )
: PDRAW ( rect dhandle -- ) ( draw a picture in a rect )
2>r a>r ,$ A8F6 ; ( _DrawPicture )
( the rects: T L B R )
rect CRECT 3 4 157 113 crect !rect ( card rect )
rect CTRECT 4 117 157 209 ctrect !rect ( control rect )
rect LCRECT 160 4 209 209 lcrect !rect ( little card rect )
rect CORECT 12 121 77 204 corect !rect ( stats group )
rect GURECT 104 121 117 204 gurect !rect ( show stats button rect )
rect TGRECT 136 121 149 204 tgrect !rect ( about button rect )
rect SCRECT 120 121 133 204 screct !rect ( show cards button rect )
rect SHRECT 88 121 101 204 shrect !rect ( reset button rect rect )
create LCRECTS ( the Little Card button rects )
163 , 8 , 206 , 42 , ( little circle )
163 , 48 , 206 , 82 , ( little cross )
163 , 88 , 206 , 122 , ( little waves )
163 , 128 , 206 , 162 , ( little square )
163 , 168 , 206 , 202 , ( little star )
: LCBRECT ( n -- addr ) 8* lcrects + ; ( get addr of button rect )
( card pictures )
create CARDS 24 allot ( an array of picture handles )
: !CARDS ( -- ) ( fill cards array )
6 0 DO
myid r+ getpict ( get a picture handle for PICT id+0 to id+5 )
cards r 4* + 2! ( stash the picture handles in 'cards' )
LOOP ;
2variable LCARD ( pict handle of the last card )
: !NC ( -- ) cards 20 + 2@ lcard 2! ; ( last card = noncard )
( draw the parts of the window )
: CHIDE ( -- ) ( draw the hidden card )
crect cards 20 + 2@ pdraw ;
: .CARD ( n -- ) ( draw the "n"th card )
crect swap 4* cards + 2@ ( get the pict handle )
2dup lcard 2! ( store pict handle into lcard )
pdraw time chide ;
: .BUTT ( n -- ) ( draw the "n"th button )
dup 0< 0= IF ( negative is no card )
dup lcbrect swap ( the button's rect )
6 + ( the button pictures start at #7 )
myid + getpict pdraw THEN ; ( get and draw it )
: BSHOW ( -- ) 5 0 DO r .butt loop ; ( draw the buttons )
: HV>CARD ( h v -- card# )
-1 rot rot 5 0 DO
2dup r lcbrect ?in IF
rot drop r rot rot
THEN LOOP 2drop ;
variable RIGHT 0 right !
variable TRIES 0 tries !
: .RIGHT right @ . ;
: .TRIES tries @ . ;
: .RANK right @ 100 tries @ */ 5 * ( percent * 5 )
dup 0< IF drop 0 THEN . ; ( correct for /0, print it )
variable BDTEXT
: .HIDE ( -- ) black 133 130 !pen ." Hide Cards" ;
: .SHOW ( -- ) black 133 130 !pen ." Show Cards" ;
' .hide bdtext !
variable BDSTATS
: .SHIDE ( -- ) black 133 114 !pen ." Show Stats" ;
: .SSHOW ( -- ) black 133 114 !pen ." Hide Stats" ;
' .sshow bdstats !
: BDRAW ( -- ) ( draw the control buttons )
bfont
10 10 tgrect rrerase
black 133 146 !pen ." Last Card"
blue 10 10 tgrect rrframe ( draw a button )
10 10 gurect rrerase
bdstats @ execute ( draw the Hide/Stats button text )
blue 10 10 gurect rrframe ( draw a button )
10 10 screct rrerase
bdtext @ execute ( draw the Hide/Show button text )
blue 10 10 screct rrframe ( draw a button )
10 10 shrect rrerase
black 133 98 !pen ." Reset Stats"
blue 10 10 shrect rrframe ; ( draw a button )
variable FFLAG -1 fflag !
: FDRAW ( -- ) ( draw the information fields )
fflag @ IF bfont
10 10 corect rrerase
blue 10 10 corect rrframe black ( draw 'stats' field )
125 23 !pen ." Statistics"
125 35 !pen ." Right:" .right
125 47 !pen ." Given:" .tries
125 59 !pen ." Rank:" .rank ." %"
124 72 !pen cfont ." ゥ '88-'93 C.Heilman"
ELSE
magenta corect rlgray ( fill background rect )
THEN ;
: DOFHIT ( -- ) ( handle show stats button )
fflag @ dup 0= fflag !
IF [ ' .shide literal ] bdstats !
ELSE [ ' .sshow literal ] bdstats ! THEN
bdraw fdraw ;
variable DOCDRAW ' .card docdraw !
: HIDE ( -- ) chide !nc
[ ' .show literal ] bdtext !
[ ' drop literal ] docdraw ! bdraw ;
: SHOW ( -- )
[ ' .hide literal ] bdtext !
[ ' .card literal ] docdraw ! bdraw ;
: HBUTT ( -- ) ( do hide button )
docdraw @ [ ' .card literal ] = IF
hide ELSE show THEN ;
: CBUTT ( n -- ) ( handle click in button for card n )
card @ deck + c@ ( get the next card from the deck )
dup rot = IF ( if it is a correct guess )
1 right +! THEN ( increment 'right' )
1 tries +! 1 card +! ( increment 'tries' and 'card' )
right @ 10000 mod right ! ( bound on right )
tries @ 10000 mod dup tries ! ( bound on tries )
0= IF 0 right ! THEN
docdraw @ execute ( display the card for a 'time' )
fdraw ( draw new stats )
card @ 25 = IF ( if it is the end of the deck )
shuffle 0 card ! THEN ; ( shuffle the deck )
: DOABOUT ( -- ) ( display an alert box )
0 >r myid >r 0 0 2>r ,$ A985 r> drop ; ( _Alert )
: LCSHOW ( -- ) ( show the last card for 2X time )
crect lcard 2@ pdraw
BEGIN ?button 0= UNTIL chide ;
: BUTTON ( -- ) ( button handler )
@mouse 2>r ( stash mouse coords on rstack )
2r hv>card dup 0< 0= IF ( if it is in a card button )
cbutt ( handle the card button )
ELSE drop ( drop the -1 flag )
2r shrect ?in IF ( in reset button )
0 card ! 0 right ! 0 tries ! ( reset variables )
shuffle fdraw bdraw !nc ( shuffle, draw stats & buttons )
ELSE ( not in reset )
2r screct ?in IF ( in show/hide button? )
hbutt ( handle show/hide button )
ELSE ( not in show/hide button )
2r tgrect ?in IF ( in last card button )
lcshow
ELSE ( not in about button )
2r gurect ?in IF ( handle show stats button )
dofhit
ELSE beep ( not in a button )
THEN
THEN
THEN
THEN
THEN 2r> 2drop ; ( drop the coords from the rstack )
: WDRAW ( -- ) ( draw the window )
magenta 4 +md rlgray ( fill background rect )
cyan 14 14 lcrect rrframe ( draw little card rect )
cyan 14 14 ctrect rrframe ( draw control rect )
fdraw bdraw chide bshow -100 -100 !pen ;
: START ( -- ) !cards
0 card ! 0 right ! 0 tries ! shuffle !nc
BEGIN key drop AGAIN ;
214 212 8 +md 2! ( set window size )
' button 16 +md ! ( button handler )
' wdraw 14 +md ! ( update handler )
' start 26 +md ! ( startup handler )
' null 18 +md @ 2+ @ 8 + ! ( paste handler )
22 +md @ 18 +md @ @ ! ( quit handler )
' doabout 24 +md ! ( about handler )
save bye