D-Bug & Automation Forum
D-Bug & Automation Forum >> Coding >> STOTRO source code..
https://d-bug.mooo.com/dbugforums/cgi-bin/yabb2/YaBB.pl?num=1232833711

Message started by Christos on 24.01.09 at 21:48:30

Title: STOTRO source code..
Post by Christos on 24.01.09 at 21:48:30
Here's the STOTRO source code. Do what you want with it but don't sell it (unless I get 50% :P).

[code]' SNDH Replayer for GFA
' Original by Swe/YesCrew
' Modified version by gwEm
'
CLS
OPTION BASE 0
DIM r%(16)
INLINE sndhplay%,186
INLINE sndhtune%,18906
DEFWRD "A-z"
'
' Address of the zik
r%(14)=sndhtune%
'
' Frequency
'
r%(7)=50
'
super%=GEMDOS(&H20,L:0)
RCALL sndhplay%+28,r%()
~GEMDOS(&H20,L:super%)
'
' Align buffer to 256 byte boundary just to be sure :)
'
DIM buffer|(288256-1)
DIM x%(8032)
buf_address%=(V:buffer|(0)+256) AND &HFFFFFF00
'
' do mask
screen_address%=XBIOS(2)
FOR i=0 TO 15
 VSETCOLOR i,0,0,0
NEXT i
COLOR 5
CIRCLE 14,15,15
COLOR 2
CIRCLE 15,15,15
FOR y=0 TO 31
 FOR x=0 TO 1
   adr%=screen_address%+x*8+y*160
   mask%=NOT (DPEEK(adr%) OR DPEEK(adr%+2) OR DPEEK(adr%+4) OR DPEEK(adr%+6))
   DPOKE adr%+16,mask%
   DPOKE adr%+18,mask%
   DPOKE adr%+20,mask%
   DPOKE adr%+22,mask%
 NEXT x
NEXT y
'
' BLOAD "data\stot7.pi1",buf_address%
OPEN "i",#1,"data\stot7.pi1"
BGET #1,buf_address%,34
~XBIOS(6,L:buf_address%+2)
VSYNC
BGET #1,buf_address%,32000
CLOSE #1
~XBIOS(5,L:buf_address%,L:buf_address%,-1)
'
OPEN "i",#1,"data\stot8.pi1"
SEEK #1,34
BGET #1,buf_address%+32000,32000
CLOSE #1
'
OPEN "i",#1,"data\chess.pi1"
SEEK #1,34
BGET #1,buf_address%+32000+32000,32000
CLOSE #1
'
OPEN "i",#1,"data\hello.pi1"
SEEK #1,34
BGET #1,buf_address%+64000+32000,32000
CLOSE #1
'
FOR i=1 TO 200
 VSYNC
NEXT i
FOR i=0 TO 200
 sc%=buf_address%+i*160
 SPOKE &HFFFF8201,SHR(sc%,16)
 SPOKE &HFFFF8203,SHR(sc%,8) AND 255
 SPOKE &HFFFF820D,sc% AND 255
 VSYNC
NEXT i
~XBIOS(5,L:sc%,L:sc%,-1)
DIM precalc(4000,1)
BLOAD "data\fuzzy.chr",V:precalc(0,0)
FOR i=1 TO 3990
 chroma=precalc(i,1)/10
 IF chroma=16
   chroma=15
 ENDIF
 COLOR chroma
 PLOT precalc(i,0),precalc(i,1)
NEXT i
FOR i=0 TO 200
 sc%=buf_address%+32000+i*160
 SPOKE &HFFFF8201,SHR(sc%,16)
 SPOKE &HFFFF8203,SHR(sc%,8) AND 255
 SPOKE &HFFFF820D,sc% AND 255
 VSYNC
NEXT i
~XBIOS(5,L:sc%,L:sc%,-1)
~XBIOS(5,L:buf_address%+64000,L:buf_address%+64000,-1)
FOR i=1 TO 10000
NEXT i
r#=90
i=0
DO
 VSYNC
 INC i
 r#=r#-0.1
 x%=159+r#*COSQ(i)
 y%=79+r#*SINQ(i)
 RC_COPY screen_address%,32,0,32,32 TO buf_address%+64000,x%,y%,1
 RC_COPY screen_address%,0,0,32,32 TO buf_address%+64000,x%,y%,7
 EXIT IF r#<0
LOOP
FOR i=0 TO 200
 sc%=buf_address%+64000+i*160
 SPOKE &HFFFF8201,SHR(sc%,16)
 SPOKE &HFFFF8203,SHR(sc%,8) AND 255
 SPOKE &HFFFF820D,sc% AND 255
 VSYNC
NEXT i
~XBIOS(5,L:sc%,L:sc%,-1)
~XBIOS(5,L:buf_address%+96000,L:buf_address%+96000,-1)
'
' plasma
'
FOR i=1 TO 5
 BLOAD "data\pic"+STR$(i)+".pic",buf_address%+(i*32000+96000)
NEXT i
DO
 INC k
 FOR i=1 TO 5
   ~XBIOS(5,L:buf_address%+96000+(i*32000),L:buf_address%+(i*32000+96000),-1)
   FOR m=1 TO 15
     FOR j=0 TO 15
       VSETCOLOR j,0,0,(j+m) MOD 16
     NEXT j
     VSYNC
   NEXT m
 NEXT i
 EXIT IF k=10
 INC k
 FOR i=4 TO 1 STEP -1
   ~XBIOS(5,L:buf_address%+96000+(i*32000),L:buf_address%+(i*32000+96000),-1)
   FOR m=1 TO 15
     VSYNC
     FOR j=0 TO 15
       VSETCOLOR j,0,0,(j+m) MOD 16
     NEXT j
   NEXT m
 NEXT i
 EXIT IF k=10
LOOP
'
' Scroller using blitter
' Coded by GGN/Paradize in 06-08-2006
' Dedicated to those that still use GFA :)
'
super%=GEMDOS(&H20,L:0)
s%=V:x%(0)
ARRAYFILL buffer|(),0
scr1%=buf_address%
scr2%=buf_address%+32000
BLOAD "DATA\goldfont.pi1",s%
~XBIOS(6,L:s%+2)
ADD s%,34
'
s_x_inc%=&HFF8A20
s_y_inc%=&HFF8A22
s_hw%=&HFF8A24
s_lw%=&HFF8A26
end_1%=&HFF8A28
end_2%=&HFF8A2A
end_3%=&HFF8A2C
d_x_inc%=&HFF8A2E
d_y_inc%=&HFF8A30
d_hw%=&HFF8A32
d_lw%=&HFF8A34
x_cnt%=&HFF8A36
y_cnt%=&HFF8A38
hop%=&HFF8A3A                    !Byte
op%=&HFF8A3B                     ! >>
skew%=&HFF8A3D                   ! >>
blit%=&HFF8A3C
'
' Construct an array of pointers that contain the letter start addresses
' (try to understand how that happens :P )
'
DIM lt_addr%(90)
off%=0
FOR i=32 TO 90
 lt_addr%(i)=s%+off%-8
 off%=off%+16
 IF off%/160=off%\160          !hehehehe
   ADD off%,31*160
 ENDIF
NEXT i
scroll_amount=4
scroll_offset=0
scroller_pos=1
right_endmask=SHR&(&HFFFF,16-scroll_amount)
text$=" THANKS FOR WATCHING THIS INTRO! CREDITS ARE: CODE: CHRISTOS, STOT LOGO: SH3-RG, MUSIC: 505, OTHER GRAPHICS: CHRISTOS: MUSIC REPLAY ROUTINE: GWEM-PHF, THIS SCROLLER: GGN-D-BUG. SO WHY DID YOU WATCH IT?"
text$=text$+" THE ST OFFLINE TOURNAMENT TEAM WOULD LIKE TO ANNOUNCE OUR PRESENCE AT OUTLINE 08 WHERE WE WILL HOLD A SPEEDBALL TOURNAMENT (ON ST). OUTLINE 08 WILL BE HELD"
text$=text$+" IN BRAAMT NL BETWEEN MAY 1 AND 4 2008. IT IS A MULTIPLATFORM PARTY AND GUARANTEED TO BE A LOT OF FUN! SO BE THERE! MANY THANKS GO TO GGN (THANKS MAN :)) , AND CYRANO JONES AND SHOWADDYWADDY FOR THEIR HELP WITH THIS INTRO."
text$=text$+"ALSO THANKS TO SH3 AND 505 FOR LENDING US THEIR TALENT AND TO THE #ATARISCNE PEOPLE. STOT ARE CHRISTOS AND KRADD. GREETINGS GO TO JA ------WRAP----- "
wrap=LEN(text$)
l_addr%=lt_addr%(ASC(MID$(text$,0,1)))  !Initialise this
shift=11
'
pixels=50
DIM offst%(pixels,1)
HIDEM
FOR i=0 TO pixels
 y=RANDOM(160)
 x=RANDOM(320)
 col=RAND(3)
 offst%(i,0)=y*160+(x\16)*8+i*2
 offst%(i,1)=SHL(1,15-(x AND 15))
NEXT i
DO
 '  CARD{&HFF8240}=&HFFF
 VSYNC
 ' CARD{&HFF8240}=0
 ~XBIOS(5,L:scr2%,L:scr2%,-1)
 '
 ' Scroll the screen
 '
 CARD{x_cnt%}=20       !20 words/line
 CARD{s_x_inc%}=8      !skip 8 bytes to get to next src word
 CARD{s_y_inc%}=8      ! ..  .. ..   ..  .. ..  ..  ..  line
 CARD{d_x_inc%}=8      ! ..  .. ..   ..  .. ..  ..  dst word
 CARD{d_y_inc%}=8      ! ..  .. ..   ..  .. ..  ..  ..  line
 CARD{end_1%}=&HFFFF   !left endmask (not used)
 CARD{end_2%}=&HFFFF   !middle ..    ( ..  .. )
 CARD{end_3%}=&HFFFF   !right  ..    ( ..  .. )
 BYTE{skew%}=-scroll_amount
 BYTE{hop%}=2           !HOG mode
 BYTE{op%}=3            !copy all src pixels
 '  CARD{&HFF8240}=&H500
 LONG{s_hw%}=scr1%+26880      !src address
 LONG{d_hw%}=scr2%+26880      !dst address
 CARD{y_cnt%}=32             !32 lines to blit
 BYTE{blit%}=192              !go for it! (freezes cpu :)
 LONG{s_hw%}=scr1%+26880+2      !src address
 LONG{d_hw%}=scr2%+26880+2      !dst address
 CARD{y_cnt%}=32             !32 lines to blit
 BYTE{blit%}=192              !go for it! (freezes cpu :)
 LONG{s_hw%}=scr1%+26880+4      !src address
 LONG{d_hw%}=scr2%+26880+4      !dst address
 CARD{y_cnt%}=32             !32 lines to blit
 BYTE{blit%}=192              !go for it! (freezes cpu :)
 LONG{s_hw%}=scr1%+26880+6      !src address
 LONG{d_hw%}=scr2%+26880+6      !dst address
 CARD{y_cnt%}=32             !32 lines to blit
 BYTE{blit%}=192              !go for it! (freezes cpu :)
 '  CARD{&HFF8240}=&H3
 '
 ' STARS
 FOR i=0 TO pixels
   off=offst%(i,0)
   val%=offst%(i,1)
   IF val%=&H8000
     CARD{ADD(scr1%,off)}=0
     CARD{ADD(scr2%,off)}=0            !APARADEKTO!!!!!!
     CARD{SUB(ADD(scr1%,off),8)}=1
     CARD{SUB(ADD(scr2%,off),8)}=1     !APARADEKTO!!!!!!
     SUB off,8
     IF off<=0
       off=ADD(off,26872)
     ENDIF
     offst%(i,0)=off
     offst%(i,1)=1
   ELSE
     val%=ADD(val%,val%)
     CARD{ADD(scr1%,off)}=val%
     CARD{ADD(scr2%,off)}=val%
     offst%(i,1)=val%
   ENDIF
 NEXT i
 '
 ' Blit portion of character
 '
 '  shift&=0 !15-(scroll_offset& AND 15)
 CARD{x_cnt%}=2        !3 word/line (2 words + 1 for shifting)
 CARD{s_x_inc%}=8      !skip bytes to get to next src word
 CARD{s_y_inc%}=152    ! ..  ..   ..  .. ..  ..  ..  line
 CARD{d_x_inc%}=8      ! ..  ..   ..  .. ..  ..  dst word
 CARD{d_y_inc%}=152    ! ..  ..   ..  .. ..  ..  ..  line
 CARD{end_1%}=&H0      !left endmask (unused)
 CARD{end_2%}=&H0      !middle ..    (unused)
 CARD{end_3%}=right_endmask      !right  ..    (
 BYTE{skew%}=shift
 BYTE{hop%}=2           !HOG mode
 BYTE{op%}=3            !copy all src pixels
 '  CARD{&HFF8240}=&H60
 LONG{s_hw%}=l_addr%       !src address
 LONG{d_hw%}=scr2%+27024       !dst address
 CARD{y_cnt%}=32             !32 lines to blit
 BYTE{blit%}=192              !go for it! (freezes cpu :)
 LONG{s_hw%}=l_addr%+2       !src address
 LONG{d_hw%}=scr2%+27024+2       !dst address
 CARD{y_cnt%}=32             !32 lines to blit
 BYTE{blit%}=192              !go for it! (freezes cpu :)
 LONG{s_hw%}=l_addr%+4       !src address
 LONG{d_hw%}=scr2%+27024+4       !dst address
 CARD{y_cnt%}=32             !32 lines to blit
 BYTE{blit%}=192              !go for it! (freezes cpu :)
 LONG{s_hw%}=l_addr%+6       !src address
 LONG{d_hw%}=scr2%+27024+6       !dst address
 CARD{y_cnt%}=32             !32 lines to blit
 BYTE{blit%}=192              !go for it! (freezes cpu :)
 SUB shift,scroll_amount
 ' CARD{&HFF8240}=&H424
 '
 ' Character logic
 '
 ADD scroll_offset,scroll_amount
 IF scroll_offset=32
   scroll_offset=0            !get new character
   shift=16-scroll_amount
   INC scroller_pos
   IF scroller_pos=wrap      !oops, need to wrap!
     scroller_pos=1
   ENDIF
   l_addr%=lt_addr%(ASC(MID$(text$,scroller_pos,1)))
 ENDIF
 IF scroll_offset=16
   ADD l_addr%,8               !point to 2nd chunk
   shift=16-scroll_amount
 ENDIF
 SWAP scr1%,scr2%
 '  CARD{&HFF8240}=&H422
LOOP UNTIL INKEY$<>""
~GEMDOS(&H20,L:super%)
~XBIOS(5,L:screen_address%,L:screen_address%,-1)
super%=GEMDOS(&H20,L:0)
RCALL sndhplay%+28+4,r%()
~GEMDOS(&H20,L:super%)
CLS
[/code]

Enjoy!

Title: Re: STOTRO source code..
Post by Christos on 24.01.09 at 21:50:36
And here is the fantastic algorithm behind the DLA fractal :)

[code]DIM screen|(320,200)
DIM precalc&(4000,1)
th=90
' Fill array screen with initial values
FOR i=0 TO 179 STEP 0.5
 x1=160+COSQ(th+i)*10
 y1=100+SINQ(th+i)*10
 x2=160-COSQ(th+i)*10
 y2=y1
 FOR j=x1 TO x2
   screen|(j,y1)=1
 NEXT j
NEXT i
counter=1
screen_address%=XBIOS(2)
' Load image
DIM buffer|(32066-1)
buf_address%=V:buffer|(0)
BLOAD "stot8.pi1",buf_address%
~XBIOS(6,L:buf_address%+2)
RC_COPY buf_address%+34,0,0,320,200 TO screen_address%,0,0
feed
fractal
saving
PROCEDURE feed
 ' place a particle in a random position on  the periphery of a circle
 ' of radius r
 fi=RAND(360)
 r=15+INT((counter/3.14)^0.63)
 x=INT(160+r*COSQ(fi))
 y=INT(100+r*SINQ(fi))
 IF screen|(x,y)=1 THEN
   GOSUB feed
 ENDIF
 IF screen|(x-1,y-1)=1 OR screen|(x-1,y)=1 OR screen|(x-1,y+1)=1 OR screen|(x,y-1)=1 OR screen|(x,y+1)=1 OR screen|(x+1,y-1)=1 OR screen|(x+1,y)=1 OR screen|(x+1,y+1)=1 THEN
   screen|(x,y)=1
   GOSUB feed
 ENDIF
RETURN
PROCEDURE fractal
 ' This is the DLA algorithm. Particle follows brownian motion. In each step
 ' a check is being performed for the existance of a neigbouring particle.
 ' If such a particle exists then the particle sticks and a new one is being
 ' released
 DO
   REM  theta=RAND(360)
   n%=RANDOM(3)-1
   x=x+n%
   IF x<160-r THEN
     x=165-r
   ENDIF
   IF x>160+r THEN
     x=155+r
   ENDIF
   IF screen|(x,y)=1 THEN
     GOSUB fractal
   ENDIF
   IF screen|(x-1,y-1)=1 OR screen|(x-1,y)=1 OR screen|(x-1,y+1)=1 OR screen|(x,y-1)=1 OR screen|(x,y+1)=1 OR screen|(x+1,y-1)=1 OR screen|(x+1,y)=1 OR screen|(x+1,y+1)=1 THEN
     screen|(x,y)=1
     PLOT x,y
     insert=1
     IF insert=1 THEN
       counter=counter+1
       precalc&(counter,0)=x
       precalc&(counter,1)=y
       GOSUB feed
     ENDIF
   ENDIF
   REM theta=RAND(360)
   m%=RANDOM(3)-1
   y=y+m%
   IF y<100-r THEN
     y=105-r
   ENDIF
   IF y>100+r THEN
     y=95+r
   ENDIF
   IF screen|(x-1,y-1)=1 OR screen|(x-1,y)=1 OR screen|(x-1,y+1)=1 OR screen|(x,y-1)=1 OR screen|(x,y+1)=1 OR screen|(x+1,y-1)=1 OR screen|(x+1,y)=1 OR screen|(x+1,y+1)=1 THEN
     screen|(x,y)=1
     PLOT x,y
     insert=1
     IF insert=1 THEN
       counter=counter+1
       precalc&(counter,0)=x
       precalc&(counter,1)=y
     ENDIF
   ENDIF
   ' PRINT AT(1,1);x,y,counter,r
   COLOR y/10
   IF counter>3500
     GOSUB saving
   ENDIF
 LOOP
RETURN
PROCEDURE saving
 BSAVE "precalc.chr",V:precalc&(0,0),4000*2*2
 END
RETURN
[/code]

D-Bug & Automation Forum » Powered by YaBB 2.6.0!
YaBB Forum Software © 2000-2022. All Rights Reserved.