\ ALHAMBRA32-prg an

DECIMAL
v: fresh vocabulary ALHAMBRA32 alhambra32 definitions

\ ---------------------- intro
: 5BITS  ( x -- x' ) hx 1F and ;
: 10BITS ( x -- x' ) hx 3FF and ;
: 16BITS ( x -- x' ) hx FFFF and ;

create TEGEL  32 dup * allot
: WIS  ( -- ) tegel 1024 bl fill ;
: PAGE ( -- ) 12 emit ;         \ Schoon scherm

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

: 5BNEGATE ( x -- -x )      negate 5bits ; \ 5bits negate
: POS>ADR  ( pos -- adr )   10bits tegel + ;
: POS>HV   ( pos -- h v )   dup 5bits swap 5 rshift 5bits ;
: HV>ADR   ( h v -- adres ) 5 lshift + POS>ADR ;

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

: PLOT+ ( h v -- ) >r
    dup r@ plot   dup r@ 5bnegate plot  \ h,v   \ h,-v
    5bnegate
    dup r@ plot   r> 5bnegate plot ;    \ -h,v  \ -h,-v
: PLOTx ( h v -- )
    2dup plot   swap 2dup plot          \ h,v   \ v,h
    5bnegate swap 5bnegate
    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 + 10bits ;
: DAAR ( -- pos ) 1024kies dup      \ Zoek een vrije plek
    begin stap dup pos>adr c@ bl <>
    while 2dup = ?abort
    repeat nip pos>hv ;

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

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

: PEMIT ( ch -- )         space emit ;
: PTYPE ( a n -- )        for count pemit next drop ;
: .LAAG ( adr horiz -- )  for dup 32 ptype next c@ pemit ;
: .BAND ( -- )   tegel 32 for dup horiz cr .laag 32 + 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 5 3 formaat  9 % 1500 to wacht ;
init

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