'
' *********************************************************************
'                              S H O W   I T !
'                           A Slide Show Program
'                            for Young Children
'                    yet another kidprg in GFA Basic from
'                               D.A. Brumleve
'                         Copyright 1989 by ST-LOG
' **********************************************************************
'                               Version 1.4
'                            February 12, 1989
' **********************************************************************
'                                REFERENCE
' **********************************************************************
' VARIABLES
' Aa%
' Alrt$
' Ax%
' Ay%
' Bb%
' Button%
' Cc%
' Dummy%
' Dur%
' First_time%
' I%
' K%
' Main_screen$
' Mk%
' Mx%
' My%
' N%
' Nt%
' Oct%
' Palette%()
' Pic$()
' Rez%
' Ss%
' Stx%
' Sty%
' Yes%
' Z$
'
' **************************** INITIALIZATION ************************
Dim Palette%(15),Pic$(6)
@Check_rez
@Save_palette
If Not Exist("DRAW_IT!.DAT")
  Alrt$="  |There are no DRAW IT! pictures|on this disk!"
  Alert 3,Alrt$,1,"Oops...",Dummy%
  Cls
  @Restore_palette
  End
Endif
Hidem
Graphmode 2
@Black_screen
Cls
For I%=1 To 5
  Get 0,56,319,199,Pic$(I%)
Next I%
Cls
@Title
K%=Xbios(35,15,0)
I%=1
First_time%=0
Repeat
Until Inkey$=""
' ***************************** MAIN PROGRAM ***************************
Top:
Repeat
  Mouse Ax%,Ay%,Button%
  Z$=Inkey$
  If Z$<>""
    First_time%=1
    Put 0,56,Pic$(I%)
    @Select_sound
    Repeat
    Until Inkey$=""
    Inc I%
    If I%>5
      I%=1
    Endif
  Endif
Until Button%>0
Sget Main_screen$
@Let_go
@Exit_routine
Hidem
If Yes%=0
  Sput Main_screen$
  Goto Top
Else
  Sput Main_screen$
  @Finale_sound
  Cls
  @Restore_palette
  K%=Xbios(35,7,7)
  End
Endif
'
' *************************** DISK ACTIVITIES **************************
Procedure Load_it
  Open "I",#1,"DRAW_IT!.DAT"
  For I%=1 To 5
    Bget #1,Varptr(Pic$(I%)),Len(Pic$(I%))
  Next I%
  Close #1
Return
'
' ********************************* SCREENS *******************************
Procedure Title
  Deftext 2,1,0,13
  Text 96,20,"S H O W   I T !"
  Deftext 6,0,0,6
  Text 35,35,"     A Slide Show Program"
  Text 35,45,"      for Young Children"
  Deffill 0
  Pbox 0,56,319,199
  Ss%=25
  Deftext 3,1,0,4
  Text 45,35+Ss%,"YET ANOTHER KIDPRG  IN GFA BASIC FROM"
  Deftext 3,0,0,4
  Text 155,35+Ss%,Chr$(191)
  Deftext 2,0,0,6
  Text 35,45+Ss%,"         D.A. Brumleve"
  Deftext 14,5,0,4
  Text 60,54+Ss%,"                      ST-LOG"
  Deftext 14,1,0,4
  Text 60,54+Ss%,"    COPYRIGHT 1989 BY"
  Deftext 2,1,0,4
  Text 60,63+Ss%,"           VERSION 1.4"
  Ss%=80
  Deftext 2,0,0,6
  Text 35,85+Ss%,"For use with files created with"
  Text 33,100+Ss%,"            DRAW IT!"
  Text 35,115+Ss%,"As published originally in    !"
  Sty%=46+Ss%
  Stx%=48
  Color 3
  Box 204+Stx%,52+Sty%,224+Stx%,73+Sty%
  Color 2
  Box 205+Stx%,53+Sty%,223+Stx%,72+Sty%
  Deffill 2,2,8
  Pbox 205+Stx%,66+Sty%,223+Stx%,72+Sty%
  Deffill 3,2,8
  Pbox 206+Stx%,54+Sty%,222+Stx%,65+Sty%
  Deftext 2,1,0,13
  Text 207+Stx%,65+Sty%," T"
  Text 205+Stx%,65+Sty%,"S"
  Deftext 3,1,0,4
  Text 205+Stx%,71+Sty%,"LOG"
  @Set_color
  @Load_it
  Deffill 1
  Pbox 10,98,309,149
  Deffill 0
  Pbox 12,100,307,147
  Deffill 1
  Pbox 14,102,305,145
  Deftext 0,0,0,6
  Text 23,118," Press any key to show a picture."
  Text 20,135,"   Press a mouse button to quit."
Return
'
' *************************** WATCH THE MOUSE *************************
Procedure Let_go
  Repeat
    Mouse Mx%,My%,Mk%
  Until Mk%=0
Return
'
Procedure Check_target
  Repeat
    Mouse Aa%,Bb%,Cc%
  Until Cc%>0 And Bb%>120 And Bb%<170 And ((Aa%>199 And Aa%<269) Or (Aa%>50 And Aa%<120))
  If Aa%>199 And Aa%<269
    Yes%=0
    Deffill 4
    Fill 198,119
  Else
    Yes%=1
    Deffill 4
    Fill 49,119
  Endif
  @Alert_sound
  @Let_go
  Pause 25
Return
'
' **************************** COLOR PALETTE **************************
Procedure Check_rez
  Rez%=Xbios(4)
  If Rez%<>0
    Alrt$=" |SHOW IT! requires|Low Resolution."
    Alert 3,Alrt$,1,"Oops!",Dummy%
    End
  Endif
Return
'
Procedure Save_palette
  For I%=0 To 15
    Palette%(I%)=Xbios(7,W:I%,W:-1)
  Next I%
Return
'
Procedure Restore_palette
  For I%=0 To 15
    Setcolor I%,Palette%(I%)
  Next I%
Return
'
Procedure Set_color
  Setcolor 0,0,0,0            !=Color# 0   black (background)
  Setcolor 15,7,7,7           !=Color# 1   white
  Setcolor 1,7,0,0            !=Color# 2   red
  Setcolor 2,0,7,0            !=Color# 3   light green
  Setcolor 4,0,0,7            !=Color# 4   bright blue
  Setcolor 6,0,6,7            !=Color# 5   light blue
  Setcolor 3,7,7,0            !=Color# 6   yellow
  Setcolor 5,7,4,5            !=Color# 7   pink
  Setcolor 7,6,6,6            !=Color# 8   light grey
  Setcolor 8,3,3,3            !=Color# 9   dark grey
  Setcolor 9,7,4,2            !=Color# 10  orange
  Setcolor 10,0,5,0           !=Color# 11  dark green
  Setcolor 12,6,3,0           !=Color# 12  brown
  Setcolor 14,0,0,0           !=Color# 13  black (for drawing)
  Setcolor 11,7,7,7           !=Color# 14  white (for filling)
  Setcolor 13,4,4,7           !=Color# 15  medium blue
Return
'
Procedure Black_screen
  For I%=0 To 15
    Setcolor I%,0,0,0
  Next I%
Return
'
' ******************************** DIALOGS *******************************
Procedure Exit_routine
  @Save_alert
  Deftext 0,0,0,6
  Text 52,100,"Do you really want to quit?"
  Showm
  @Check_target
Return
'
Procedure Save_alert
  If First_time%=0
    Deffill 1
    Pbox 0,56,319,199
    Deffill 0
    Pbox 2,58,317,197
  Endif
  Deffill 1
  Pbox 5,60,314,195
  Deffill 0
  Pbox 51,121,119,169
  Pbox 200,121,268,169
  Color 14
  Box 48,118,122,172
  Box 197,118,271,172
  Deffill 4
  Pbox 52,122,118,168
  Deffill 1
  Pbox 201,122,267,168
  Deftext 0,0,0,13
  Text 70,150,"Yes!"
  Text 225,150,"No."
Return
'
' ******************************* SOUNDS *********************************
Procedure Select_sound
  Sound 1,15,6,3,2
  Sound 1,15,6,4,2
  Sound 1,15,8,4,6
  Sound 1,0,0,0,0
Return
'
Procedure Alert_sound
  Sound 1,15,10,3,2
  Sound 1,0,0,0,0
Return
'
Procedure Finale_sound
  Restore Finale_data
  Read N%
  For I%=1 To N%
    Read Nt%,Oct%,Dur%
    Sound 1,15,Nt%,Oct%,Dur%
    Sound 1,0,0,0,0
    Pause 5
  Next I%
Return
'
' ********************************* DATA *******************************
Finale_data:
Data 7
Data 6,4,16
Data 1,4,8
Data 1,4,8
Data 3,4,16
Data 1,4,32
Data 5,4,16
Data 6,4,64
'