\ alhambra16-prg an

DECIMAL
v: fresh vocabulary ALHAMBRA16 alhambra16 definitions

\ ---------------------- intro
: PAGE ( -- ) 12 emit ;         \ Schoon scherm

: 4BITS  ( x -- x' ) hx 0F and ;
: 8BITS  ( x -- x' ) hx FF and ;
: 16BITS ( x -- x' ) hx FFFF and ;
: 4BNEGATE ( x -- -x ) negate 4bits ;

0 value RND
: RANDOM  ( -- u ) rnd 31421 * 6927 + 16bits dup to rnd ;
: 256KIES ( -- 8bits ) random 8 rshift ;

create TEGEL  16 dup * allot
: WIS  ( -- ) tegel 256 bl fill ;
: POS>ADR  ( pos -- adr )   8bits tegel + ;
: POS>HV   ( pos -- h v )   dup 4bits swap 4 rshift 4bits ;
: HV>ADR   ( h v -- adres ) 4 lshift + POS>ADR ;

\ ---------------------- Patroon ontwerpen
: PLOT  ( h v -- )  hv>adr ch @ swap c! ;

: PLOT+ ( h v -- ) >r
    dup r@ plot   dup r@ 4bnegate plot  \ h,v   \ h,-v
    4bnegate
    dup r@ plot   r> 4bnegate plot ;    \ -h,v  \ -h,-v
: PLOTx ( h v -- )
    2dup plot   swap 2dup plot          \ h,v   \ v,h
    4bnegate swap 4bnegate
    2dup plot   swap plot ;             \ -h,-v \ -v,-h
: PLOT* ( h v -- )  2dup plot+   swap plot+ ;

\ ---------------------- P+ Px P*
0 value (%)     \ Percentage witte steentjes
: %  ( n -- ) 100 umin to (%) ;

: STAP ( x -- x+101 ) 101 + 8bits ;
: DAAR ( -- h v ) 256kies dup       \ Zoek een vrije plek
    begin stap dup pos>adr c@ bl <>
    while 2dup = ?abort
    repeat nip pos>hv ;

: P+ ( nr -- ) to rnd wis
    (%) 81 100 */ for daar plot+ next ;  \ 81=vol
: Px ( nr -- ) to rnd wis
    (%) 73 100 */ for daar plotx next ;  \ 73=vol
: P* ( nr -- ) to rnd wis
    (%) 45 100 */ for daar plot* next ;  \ 45=vol

\ ---------------------- Patroon afdrukken
0 value HORIZ   0 value VERTI
: FORMAAT ( horiz verti -- )
    6 min 1 max to verti  10 min 1 max to horiz ;

: PEMIT ( ch -- )         space emit ;
: PTYPE ( a n -- )        for count pemit next drop ;
: .LAAG ( adr horiz -- )  for dup 16 ptype next c@ pemit ;
: .BAND ( -- )   tegel 16 for dup horiz cr .laag 16 + next drop ;
: .pf   ( -- ) page verti for .band next cr tegel horiz .laag cr ;
: .P ( horiz verti -- )   formaat .pf ;

\ -------------------- Demo's
0 value WACHT   1500 to wacht
: (DEMO) ( nr -- nr+1 ) ." nr " dup . 1+
                     (%) 0 .r ." % " wacht ms ;
: DEMO+ ( nr -- ) begin dup p+ .pf ." DEMO+ " (demo) stop? until drop ;
: DEMOx ( nr -- ) begin dup px .pf ." DEMOx " (demo) stop? until drop ;
: DEMO* ( nr -- ) begin dup p* .pf ." DEMO* " (demo) stop? until drop ;
: INIT 10 6 formaat  9 % 1500 to wacht ;
init

v: fresh
shield alhambra16\
v: alhambra16
\ <><> ( 5 values )