Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive : PICKIT.ZIP
Filename : SCRLDEMO.PRG
Output of file : SCRLDEMO.PRG contained in archive : PICKIT.ZIP
* Sorry if it's opaque in spots, but it's hard to find time to write clear code.
*
SET TALK OFF
SET SCOR OFF
SET SAFE OFF
ON ESCA DO AHA
ON ESCA
LOAD SCROLL
LOAD CURONOFF
CALL CURONOFF WITH "F"
set color to w+/b
centerrow=12
centercol=40
windowsize=1
attrcount=0
*Boxes outward!
DO WHIL attrcount<23
mparam="B"+LTRI(STR(INT(centerrow-(windowsize/2))))+","+LTRI(STR(centercol-windowsize))+","+LTRI(STR(INT(centerrow+(windowsize/2))))+","+LTRI(STR(centercol+windowsize))+","+LTRI(STR(attrcount*16))
CALL SCROLL WITH mparam
attrcount=attrcount+1
windowsize=windowsize+1
ENDDO
bigwind=windowsize
@0,0 SAY "If you don't"
@1,0 SAY "have color,"
@2,0 SAY "you're missing"
@3,0 SAY "the show!!"
*And inward
DO WHIL attrcount>2
mparam="B"+LTRI(STR(INT(centerrow-(windowsize/2))))+","+LTRI(STR(centercol-windowsize))+","+LTRI(STR(INT(centerrow+(windowsize/2))))+","+LTRI(STR(centercol+windowsize))+","+LTRI(STR(attrcount*16))
CALL SCROLL WITH mparam
attrcount=attrcount-1
windowsize=windowsize-1
ENDDO
*shake it!
shakount=1
DO WHIL shakount<15
mparam=IIF(MOD(shakount,2)=1,"L","R")+"4,0,14,24,65,31"
CALL scroll WITH mparam
shakount=shakount+1
ENDD
*DO WHIL windowsize < (bigwind+1)
* mparam="L"+LTRI(STR(windowsize*2))+","+LTRI(STR(INT(centerrow-(windowsize/2))))+","+LTRI(STR(centercol-windowsize))+","+LTRI(STR(INT(centerrow+(windowsize/2))))+","+LTRI(STR(centercol+windowsize))+",31"
* CALL SCROLL WITH mparam
* windowsize=windowsize+4
*ENDDO
mparam="L1,0,14,24,65,31"
curtain=0
DO WHIL curtain<50
CALL scroll WITH mparam
curtain = curtain+1
ENDD
mparam="U1,0,14,24,14,31"
curtain=0
DO WHIL curtain<25
CALL scroll WITH mparam
curtain=curtain+1
ENDD
CLEAR
windowsize=5
attrcount=15
*box in the middle of screen
mparam="B"+LTRI(STR(INT(centerrow-(windowsize/2))))+","+LTRI(STR(centercol-windowsize))+","+LTRI(STR(INT(centerrow+(windowsize/2))))+","+LTRI(STR(centercol+windowsize))+","+LTRI(STR(attrcount*112))
CALL SCROLL WITH mparam
@10,38 SAY "Weird"
@12,38 SAY "Stuff!"
*move it up, funnily
DO WHIL centerrow>2
mparam="U1,"+LTRI(STR(INT(centerrow-(windowsize/2))+2))+","+LTRI(STR(centercol-windowsize))+","+LTRI(STR(INT(centerrow+(windowsize/2))+2))+","+LTRI(STR(centercol+windowsize))+",31"
CALL SCROLL WITH mparam
centerrow=centerrow-1
IF MOD(centerrow,2)=1
mparam="B"+LTRI(STR(INT(centerrow-(windowsize/2))))+","+LTRI(STR(centercol-windowsize))+","+LTRI(STR(INT(centerrow+(windowsize/2))))+","+LTRI(STR(centercol+windowsize))+","+LTRI(STR(attrcount*16))
CALL SCROLL WITH mparam
@INT(centerrow-windowsize/2)+1,38 SAY "Weird"
@INT(centerrow-windowsize/2)+3,38 SAY "Stuff!"
ENDI
ENDD
*Now sideways, blinking
DO WHIL centercol>6
mparam="B"+LTRI(STR(INT(centerrow-(windowsize/2))))+","+LTRI(STR(centercol-windowsize))+","+LTRI(STR(INT(centerrow+(windowsize/2))))+","+LTRI(STR(centercol+windowsize+2))+",31"
CALL SCROLL WITH mparam
centercol=centercol-2
mparam="B"+LTRI(STR(INT(centerrow-(windowsize/2))))+","+LTRI(STR(centercol-windowsize))+","+LTRI(STR(INT(centerrow+(windowsize/2))))+","+LTRI(STR(centercol+windowsize))+","+LTRI(STR(attrcount*16))
CALL SCROLL WITH mparam
ENDD
@1,2 say "Stranger"
@2,3 SAY "Still"
mparam="D10,0,0,24,15,31"
CALL scroll WITH mparam
mparam="U10,0,0,24,15,31"
CALL scroll WITH mparam
mparam="D10,0,0,24,15,31"
CALL scroll WITH mparam
mparam="U10,0,0,24,15,31"
CALL scroll WITH mparam
mparam="D10,0,0,24,15,31"
CALL scroll WITH mparam
mparam="U10,0,0,24,15,31"
CALL scroll WITH mparam
mparam="D10,0,0,24,15,31"
CALL scroll WITH mparam
mparam="U10,0,0,24,15,31"
CALL scroll WITH mparam
mparam="D11,0,0,24,15,31"
CALL scroll WITH mparam
mparam="U11,0,0,24,15,31"
CALL scroll WITH mparam
mparam="D21,0,0,24,15,31"
CALL scroll WITH mparam
ckount=1
DO whil ckount<71
mparam="R1,21,0,24,79,31"
CALL SCROLL WITH mparam
ckount=ckount+1
ENDD
*now diagonally (sort of)
frow='19'
lrow='24'
fcol='67'
lcol='79'
DO WHIL VAL(frow)>8
mparam='U1,'+frow+','+fcol+','+lrow+','+lcol+','+'31'
CALL SCROLL WITH mparam
mparam=STUF(mparam,1,2,"L3")
CALL SCROLL WITH mparam
frow=LTRI(STR(VAL(frow)-1))
lrow=LTRI(STR(VAL(lrow)-1))
fcol=LTRI(STR(VAL(fcol)-3))
lcol=LTRI(STR(VAL(lcol)-3))
ENDDO
mparam='L2,'+frow+','+fcol+','+lrow+','+lcol+','+'31'
CALL SCROLL WITH mparam
mparam='L1,10,35,13,44,120'
CALL SCROLL WITH mparam
@9,34 TO 14,45 DOUBLE
@0,21 TO 4,59 DOUBLE
@2,23 SAY "You can expect it from me
ON ESCA @23,1 SAY "Don't worry, it's all in the game plan"
set deci to 0
fireworks=0
DO WHIL fireworks<150
attr=fireworks
frow=MOD(VAL(IIF(MOD(fireworks,2)=0,RIGH(TIME(),2),RIGH(TIME(),1)+SUBS(TIME(),7,1)))*MOD(fireworks,8),80)
lrow=frow+(VAL(RIGH(STR(frow),1))*MOD(INT(111/fireworks*(frow+31)),2)+(MOD(frow,10)*MOD(frow,7)))
fireworks=fireworks+1
fcol=MOD(VAL(RIGH(TIME(),1))*VAL(RIGH(TIME(),1)+SUBS(TIME(),7,1))*IIF(MOD(fireworks,3)=0,43,7),25)
lcol=fcol+MOD(frow*fcol*89,25)
dr=SUBS("UDLRB",MOD(fireworks,5)+1,1)
lines=MOD(fireworks,80)
mparam=dr+LTRI(STR(lines))+","+LTRI(STR(frow))+","+LTRI(STR(fcol))+","+LTRI(STR(lrow))+","+LTRI(STR(lcol))+","+LTRI(STR(attr))
CALL SCROLL WITH mparam
ENDD
SET ESCA OFF
CLEAR
@22,1 SAY "Just wanted you to see a little bit of what it was like to debug this sucker"
@23,1 SAY "
read
ccount=1
DO WHIL ccount<160
IF MOD(ccount,2)=0
CALL SCROLL WITH "L1,22,0,22,79,31"
CALL SCROLL WITH "r1,23,0,23,79,31"
* READ
ENDI
ccount=ccount+1
ENDD
CLEAR
SET ESCA ON
ON ESCA
CALL CURONOFF
RETU
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/