Here it is using your first method.
left and right arrow keys.
I would have used your second method but it was too difficult for me.
Made it cross platform too.
Code: Select all
EnableExplicit
#X = 400
#Y = 600
#Z = 15 ; speed
Declare.s MakeWord(Mode = 0, WordLength = 0)
Declare.s RandomLine()
Declare.i Init()
Declare.i PageForward(p)
Declare.i PageBackward(p)
Declare.i Main()
If Init()
Main()
EndIf
End
Procedure Main()
Protected p = 1
Repeat
Select WaitWindowEvent()
Case #PB_Event_Menu
Select EventMenu()
Case 1 ; go forward
If p < 19 : p + 2 : PageForward(p) : EndIf
Case 2 ; go backward
If p > 01 : p - 2 : PageBackward(p) : EndIf
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
EndProcedure
Procedure PageForward(p)
Protected i,j,x
For i = 1 To #Z ; do right page
x = (#X*i) / #Z
StartDrawing(CanvasOutput(0))
DrawImage(ImageID(p+1),#X,0) ; right complete
DrawImage(ImageID(p-1),#X,0,#X-x,#Y) ; right turning
StopDrawing()
Delay(25)
Next i
For i = 1 To #Z ; do left page
x = (#X*i) / #Z
StartDrawing(CanvasOutput(0))
;DrawImage(ImageID(p-2),0,0) ; left complete
DrawImage(ImageID(p),#X-x,0,x,#Y) ; left turning
StopDrawing()
Delay(25)
Next i
EndProcedure
Procedure PageBackward(p)
Protected i,j,x
For i = 1 To #Z ; do left page
x = #X*i / #Z
StartDrawing(CanvasOutput(0))
DrawImage(ImageID(p),0,0) ; left complete
DrawImage(ImageID(p+2),x,0,#X-x,#Y) ; left turning
StopDrawing()
Delay(25)
Next i
For i = 1 To #Z ; do right page
x = (#X*i) / #Z
StartDrawing(CanvasOutput(0))
;DrawImage(ImageID(p+3),#X,0) ; right complete
DrawImage(ImageID(p+1),#X,0,x,#Y) ; right turning
StopDrawing()
Delay(25)
Next i
EndProcedure
Procedure Init()
Protected i,j,x,m,n,c,result
Protected s.s
result = OpenWindow(0,0,0,#X+#X,#Y,"Page flip effect")
If result
CanvasGadget(0,0,0,#X+#X,#Y)
AddKeyboardShortcut(0,#PB_Shortcut_Right,1)
AddKeyboardShortcut(0,#PB_Shortcut_Left,2)
LoadFont(0,"Courier New", 10)
For i=1 To 20
CreateImage(i,#X,#Y)
StartDrawing(ImageOutput(i))
DrawingFont(FontID(0))
Box(0,0,#X,#Y,$FFFFFF)
If i&1
m=#X
n=-1
Else
m=0
n=1
EndIf
For j=0 To 15
c=$10101*j*8+$808080
LineXY(m,0,m,#Y,c)
m+n
Next j
For j=1 To 28
DrawText(24,20*j,RandomLine(),0,$FFFFFF)
Next j
s=Str(i)
If i&1
x=10
Else
x=#X-10-TextWidth(s)
EndIf
DrawText(x,#Y-20,Str(i),$0000FF,$FFFFFF)
StopDrawing()
Next i
StartDrawing(CanvasOutput(0))
DrawImage(ImageID(1),0,0)
DrawImage(ImageID(2),#X,0)
StopDrawing()
EndIf
ProcedureReturn result
EndProcedure
Procedure.s RandomLine()
Static wc
Protected result.s = MakeWord(Bool(wc = 0)) : wc + 1
While Len(result) < 35
If wc > 3 And Random(4) = 0
If Random(1) And wc < 8 : result + "," : wc = 3
Else : result + ". " : wc = 0
EndIf
Else
result + " " + MakeWord(Bool(wc = 0)) : wc + 1
EndIf
Wend
ProcedureReturn result
EndProcedure
Procedure.s MakeWord(Mode = 0, WordLength = 0)
; procedure returns a randomly constructed word
; mode = 0 --- all lower case (default)
; mode = 1 --- first letter is upper case
; mode = 2 --- all upper case
; if WordLength = 0 (default) then word length is random 3 to 10
Protected vcFlag.i, LL$, NL$, word$
Static cc ; the number of available consonants
Static sc ; the number of special consonants
Static vc ; the number of available vowels
Static sv ; the number of special vowels
Static sb ; the number of special beginnings
Static con$ ; stores all of the available consonants
Static vow$ ; stores all of the available vowels
Static beg$ ; stores all special beginnings consonants
Static init = #True
Macro GetData(dataBlock, counterVariable, storageString)
Restore dataBlock
Read.s LL$
While LL$
counterVariable + 1
storageString + LL$
Read.s LL$
Wend
EndMacro
If init ; do this only once
; count and store all the consonants and vowels
GetData(consonants, cc, con$)
GetData(specialConsonants, sc, con$)
cc + sc - 1
GetData(vowels, vc, vow$)
GetData(specialVowels, sv, vow$)
vc + sv - 1
GetData(specialBeginnings, sb, beg$)
sb - 1
init = #False
EndIf
If WordLength < 1
WordLength = 3 + Random(3) + Random(2) + Random(2)
EndIf
If Random(10) > 2 ; make first letter a consonant
If Not Random(10) ; use a special beginning
word$ = RTrim(Mid(beg$, 1 + Random(sb) << 1, 2))
Else
word$ = RTrim(Mid(con$, 1 + Random(cc - sc) << 1, 2))
EndIf
vcFlag = #False
Else ; make first letter a vowel
word$ = RTrim(Mid(vow$, 1 + Random(vc - sv) << 1, 2))
vcFlag = #True
EndIf
LL$ = Right(word$,1)
While Len(word$) < WordLength ; choose the remaining letters
Repeat
Repeat
If vcFlag ; last was vowel so add a consonant
NL$ = RTrim(Mid(con$, 1 + Random(cc) << 1, 2))
Else ; last was consonant so add a vowel
NL$ = RTrim(Mid(vow$, 1 + Random(vc) << 1, 2))
EndIf
Until NL$ <> LL$
Until Len(word$) + Len(NL$) <= WordLength
word$ + NL$ : LL$ = Right(NL$,1) : vcFlag ! 1
Wend
Select mode
Case 0 ; default all lower case
; do nothing
Case 1 ; make first letter upercase
word$ = UCase(Left(word$,1)) + Right(word$,Len(word$)-1)
Case 2 ; make all letters uppercase
word$ = UCase(word$)
EndSelect
ProcedureReturn word$
DataSection
specialBeginnings: ; only used at word beginnings
Data.s "bl","br","cl","cr","dr","fl","fr","gr","kl","kr","pl","pr","qu","sl","sm"
Data.s "sn","sp","sw"
Data.s ""
consonants:
Data.s "b ","b ","c ","c ","c ","c ","d ","d ","d ","d ","d ","d ","f ","f ","f "
Data.s "g ","g ","g ","h ","h ","h ","h ","h ","h ","h ","h ","j ","j ","k ","l "
Data.s "l ","l ","l ","l ","m ","m ","m ","n ","n ","n ","n ","n ","n ","n ","n "
Data.s "n ","p ","p ","p ","r ","r ","r ","r ","r ","r ","r ","r ","s ","s ","s "
Data.s "s ","s ","s ","s ","s ","s ","t ","t ","t ","t ","t ","t ","t ","t ","t "
Data.s "t ","t ","t ","v ","w ","w ","w ","x ","x ","y ","y ","y ","z ","ch","th"
Data.s "sh","st","sk","sp","tr","ph"
Data.s ""
specialConsonants: ; never used at begining of words
Data.s "ng","nt","rk","nd","ck","ds","ks","rt","nk","bb","gg","ll","nn","ss"
Data.s ""
vowels:
Data.s "a ","a ","a ","e ","e ","e ","e ","e ","i ","i ","i "
Data.s "o ","o ","o ","u ","a ","a ","a ","e ","e ","e ","e "
Data.s "e ","i ","i ","i ","o ","o ","o ","u "
Data.s ""
specialVowels: ; never used at beginning of words
Data.s "oa","ea","ie","ia","ya","yo","oo","ee","y "
Data.s ""
EndDataSection
EndProcedure
!!! 
download.