Page Index Toggle Pages: 1 Send TopicPrint
STOTRO source code.. (Read 86 times)
Christos
Distributor
Reboot Member
**
Offline


D-BUGer

Posts: 212
Joined: 06.03.07
STOTRO source code..
24.01.09 at 21:48:30
Print Post  
Here's the STOTRO source code. Do what you want with it but don't sell it (unless I get 50% Tongue).

Code
Select All
' 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
 



Enjoy!
  
Back to top
 
IP Logged
 
Christos
Distributor
Reboot Member
**
Offline


D-BUGer

Posts: 212
Joined: 06.03.07
Re: STOTRO source code..
Reply #1 - 24.01.09 at 21:50:36
Print Post  
And here is the fantastic algorithm behind the DLA fractal Smiley

Code
Select All
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
 

  
Back to top
 
IP Logged
 
Page Index Toggle Pages: 1
Send TopicPrint
 
  « Board Index ‹ Board  ^Top