Rem TDK_Man's Wacky Alarm Clock
Rem DBC Challenge Entry
 
Gosub Setup
Do
  Gosub DecodeTime
  Gosub PositionHands
  If AlarmGoingOff = True Then Gosub Rotation
  If Scancode() = 57
    Repeat
    Until Scancode()=0
    If SettingAlarm = False
      Rem Not In Process Of Setting Alarm
      If AlarmSet = True
        Gosub CancelAlarm
      Else
        SettingAlarm = True
      Endif
      If AlarmGoingOff = True
        Rem Alarm Currently Going Off
        Gosub CancelAlarm
        Ghost Object Off 1
        Position Camera 0,0,-15
        Point Camera 0,0,0
      Endif
    Else
      Rem Cancel Setting Alarm
      Gosub CancelAlarm
    Endif
  Endif
  If SettingAlarm = True Then Gosub AlarmInput
  Sync
  Text 0,0,"Alarm Set: "+TripTime$
  Text 0,580,"Time: "+Get Time$()
  Center Text 400,0,Message$
Loop
End
 
Rem ******************************************************************
Rem ***                      Procedures                            ***
Rem ******************************************************************
 
CancelAlarm:
  SettingAlarm = False: AlarmGoingOff = False
  SetHour = False: SetAlarm = False
  TripTime$ = "": AHour$ = "": AMin$ = ""
  Message$="Press Space To Set Alarm"
Return
 
AlarmInput:
  Message$="Entering Alarm Time (Space Again To Cancel)"
  If SetAlarm = False
    If SetHour = False
      Center Text 400,580,"Enter Hour (0-23): "+AHour$
      K = Scancode()
      If K=11
        AHour$ = AHour$ + "0"
        Repeat
        Until Scancode()=0
      Endif
      If K>1 and K<11
        If Len(AHour$)<2 Then AHour$ = AHour$ + Chr$(K+47)
        Repeat
        Until Scancode()=0
      Endif
      If K=14
        Repeat
        Until Scancode()=0
        If Len(AHour$)=1 Then AHour$ = ""
        If Len(AHour$)>1 Then AHour$ = Left$(AHour$,Len(AHour$)-1)
      Endif
      If K=28
        Repeat
        Until Scancode()=0
        If Len(AHour$)<2 Then AHour$ = "0"+AHour$
        SetHour = True
      Endif
    Else
      Center Text 400,580,"Enter Minutes (0-59): "+AMin$
      K = Scancode()
      If K=11
        AMin$ = AMin$ + "0"
        Repeat
        Until Scancode()=0
      Endif
      If K>1 and K<11
        If Len(AMin$)<2 Then AMin$ = AMin$ + Chr$(K+47)
        Repeat
        Until Scancode()=0
      Endif
      If K=14
        Repeat
        Until Scancode()=0
        If Len(AMin$)=1 Then AMin$ = ""
        If Len(AMin$)>1 Then AMin$ = Left$(AMin$,Len(AMin$)-1)
      Endif
      If K=28
        Repeat
        Until Scancode()=0
        SetAlarm = True
        SettingAlarm = False
        If Len(AMin$)<2 Then AMin$ = "0"+AMin$
        TripTime$ = AHour$+":"+AMin$+":"+"00"
        Message$ = "Press Space To Cancel Alarm"
      Endif
    Endif
  Endif
Return
 
DecodeTime:
  T$ = Get Time$()
  Sec = Val(Right$(T$,2))
  Hr = Val(Left$(T$,2))
  If Hr > 12 Then Dec Hr,12
  Min = Val(Left$(Right$(T$,5),2))
  HourCreep# = 30.0/(60.0/(Min+1))
  If SetAlarm = True
    If Get Time$() = TripTime$
      T = Timer()
      AlarmGoingOff = True
      Message$="Press Space Bar To Stop Alarm"
    Endif
  Endif
Return
 
Rotation:
  Elapsed = (Timer()-T)/1000
  If Elapsed = 10 Then Ghost Object On 1
  X# = WrapValue(X# + .1): Y# = WrapValue(Y# + .1): Z# = WrapValue(Z# + .1)
  Inc YDist#,YDVal#
  If YDist# <= -30.0 or YDist# >= 30.0 Then YDVal# = 0-YDVal#
  NewX# = NewXValue(Object Position X(1),X#,XDist#)
  NewY# = NewYValue(Object Position Y(1),Y#,YDist#)
  NewZ# = NewZValue(Object Position Z(1),Z#,ZDist#)
  YRotate Object 100,WrapValue(Object Angle Y(100)+.2)
  YRotate Object 101,WrapValue(Object Angle Y(101)-.2)
  XRotate Object 102,WrapValue(Object Angle X(102)+.2)
  XRotate Object 103,WrapValue(Object Angle X(103)-.2)
  YRotate Object 104,WrapValue(Object Angle Y(104)+.2)
  YRotate Object 105,WrapValue(Object Angle Y(105)-.2)
  Position Camera NewX#,NewY#,NewZ#
  Point Camera 0,0,0
Return
 
PositionHands:
  Rem Seconds
  YRotate Object 2,WrapValue(Sec*6): Rem Top
  YRotate Object 3,WrapValue((Sec+30)*-6): Rem Bottom
  XRotate Object 4,WrapValue((Sec+15)*-6): Rem Left
  XRotate Object 5,WrapValue((Sec-15)*6): Rem Right
  YRotate Object 6,WrapValue((Sec+30)*-6): Rem Front
  YRotate Object 7,WrapValue((Sec+30)*6): Rem Back
  Rem Minutes
  YRotate Object 8,WrapValue(Min*6): Rem Top
  YRotate Object 9,WrapValue((Min+30)*-6): Rem Bottom
  XRotate Object 10,WrapValue((Min+15)*-6): Rem Left
  XRotate Object 11,WrapValue((Min-15)*6): Rem Right
  YRotate Object 12,WrapValue((Min+30)*-6): Rem Front
  YRotate Object 13,WrapValue((Min+30)*6): Rem Back
  Rem Hours
  YRotate Object 14,WrapValue(Hr*30+HourCreep#): Rem Top
  YRotate Object 15,WrapValue(((Hr+6)*-30)-HourCreep#): Rem Bottom
  XRotate Object 16,WrapValue(((Hr+3)*-30)-HourCreep#): Rem Left
  XRotate Object 17,WrapValue(((Hr-3)*30)+HourCreep#): Rem Right
  YRotate Object 18,WrapValue(((Hr+6)*-30)-HourCreep#): Rem Front
  YRotate Object 19,WrapValue(((Hr+6)*30)+HourCreep#): Rem Back
Return
 
Setup:
  Set Display Mode 800,600,32
  AutoCam Off
  Hide Mouse
  Sync On
  Sync Rate 0
  Backdrop On
  Color Backdrop 0
  CLS
  Gosub Clock
  MakeCog(100,5): Position Object 100,0,3,0: Rem Top
  MakeCog(101,5): Position Object 101,0,-3,0: Rem Bottom
  MakeCog(102,5): ZRotate Object 102,90: Position Object 102,-3,0,0: Rem Left
  MakeCog(103,5): ZRotate Object 103,90: Position Object 103,3,0,0: Rem Right
  MakeCog(104,5): XRotate Object 104,90: Position Object 104,0,0,-3: Rem Front
  MakeCog(105,5): XRotate Object 105,90: Position Object 105,0,0,3: Rem Back
  Position Camera 0,0,-15
  Point Camera 0,0,0
  XDist#=25.0: YDist#=0.0: ZDist#=15.0: YDVal#=.1
  True=1: False=0: SetHour = False: SetAlarm = False
  AHour$="": AMin$=""
  Message$="Press Space To Set Alarm"
Return
 
Clock:
  Rem Texture
  Create Bitmap 1, 1024,768
  For N=1 To 128
    Ink RGB(N,0,255-N),0
    Circle 128,128,N
    Circle 128,129,N
  Next N
  Ink RGB(255,255,255),0
  Circle 128,128,126
  Circle 128,128,122
  Set Text Font "Tahoma"
  Text 121,9,"XII"
  Text 185,27,"I"
  Text 222,67,"II"
  Text 235,121,"III"
  Text 221,178,"IV"
  Text 180,218,"V"
  Text 121,232,"VI"
  Text 66,218,"VII"
  Text 25,178,"VIII"
  Text 10,121,"IX"
  Text 27,67,"X"
  Text 65,27,"XI"
  Get Image 1,0,0,256,256
  Set Current Bitmap 0
  Delete Bitmap 1
  Ink RGB(255,255,255),0
  Rem Face
  MakeLimbCube(1,10.0)
  Texture LIMB 1,1,1: Texture LIMB 1,2,1
  Texture LIMB 1,3,1: Texture LIMB 1,4,1
  Texture LIMB 1,5,1: Texture LIMB 1,6,1
  Rem Create Spindles
  For N=2 To 19
    Make Object Cylinder N,.2
    Color Object N,RGB(100,0,0)
  Next N
  Position Object 2,0,5.1,0
  Position Object 8,0,5.1,0
  Position Object 14,0,5.1,0
  Position Object 3,0,-5.1,0
  Position Object 9,0,-5.1,0
  Position Object 15,0,-5.1,0
  ZRotate Object 4,90
  Position Object 4,-5.1,0,0
  ZRotate Object 10,90
  Position Object 10,-5.1,0,0
  ZRotate Object 16,90
  Position Object 16,-5.1,0,0
  ZRotate Object 5,90
  Position Object 5,5.1,0,0
  ZRotate Object 11,90
  Position Object 11,5.1,0,0
  ZRotate Object 17,90
  Position Object 17,5.1,0,0
  XRotate Object 6,90
  Position Object 6,0,0,-5.1
  XRotate Object 12,90
  Position Object 12,0,0,-5.1
  XRotate Object 18,90
  Position Object 18,0,0,-5.1
  XRotate Object 7,90
  Position Object 7,0,0,5.1
  XRotate Object 13,90
  Position Object 13,0,0,5.1
  XRotate Object 19,90
  Position Object 19,0,0,5.1
  Rem Create Second Hands
  For N=20 To 25
    Make Object Box N,.02,.005,4.4
    Color Object N,RGB(255,0,0)
    Glue Object To Limb N,N-18,0
    Offset Limb N,0,0,0,2.2
  Next N
  Rem Create Minute Hands
  For N=26 To 31
    Make Object Box N,.08,.005,4.0
    Color Object N,RGB(255,255,255)
    Glue Object To Limb N,N-18,0
    Offset Limb N,0,0,.02,2.0
  Next N
  Rem Create Hour Hands
  For N=32 To 37
    Make Object Box N,.08,.005,3.0
    Color Object N,RGB(255,255,255)
    Glue Object To Limb N,N-18,0
    Offset Limb N,0,0,.04,1.5
  Next N
  Set Object 1,1,0,0
Return
 
Rem ******************************************************************
Rem ***                       Functions                            ***
Rem ******************************************************************
 
Function MakeCog(ObjNum,Size)
  RootObjNum = ObjNum*100
  Make Object Cylinder ObjNum,Size
  Scale Object ObjNum,100,11,100
  Color Object ObjNum,RGB(192,192,192)
  For N=0 To 59
    Make Object Box RootObjNum+N,Size+.3,3,.15
    Color Object RootObjNum+N,RGB(162,162,162)
    YRotate Object RootObjNum+N,N*6
    Glue Object To Limb RootObjNum+N,ObjNum,0
  Next N
EndFunction
 
Function MakeLimbCube(ObjNum,Size#)
  Offset#=Size#/2.0: MeshNum=2000: PlainNum=2000
  Make Object Cube ObjNum,Size#
  Make Object Plain PlainNum,Size#,Size#
  Make Mesh From Object MeshNum,PlainNum
  ADD LIMB ObjNum,1,2000: Offset Limb ObjNum,1,0,0,0.0-Offset#: Rem Cube Side 1 (Front)
  ADD LIMB ObjNum,2,2000: Rotate Limb ObjNum,2,0,90,0: Offset Limb ObjNum,2,0.0-Offset#,0,0: Rem Cube Side 2 (Left)
  ADD LIMB ObjNum,3,2000: Rotate Limb ObjNum,3,0,180,0: Offset Limb ObjNum,3,0,0,Offset#:  Rem Cube Side 3 (Back)
  ADD LIMB ObjNum,4,2000: Rotate Limb ObjNum,4,0,270,0: Offset Limb ObjNum,4,Offset#,0,0:  Rem Cube Side 4 (Right)
  ADD LIMB ObjNum,5,2000: Rotate Limb ObjNum,5,270,0,0: Offset Limb ObjNum,5,0,0.0-Offset#,0: Rem Cube Side 5 (Bottom)
  ADD LIMB ObjNum,6,2000: Rotate Limb ObjNum,6,90,0,0: Offset Limb ObjNum,6,0,Offset#,0: Rem Cube Side 6 (Top)
  Delete Mesh MeshNum
  Delete Object PlainNum
  Hide Limb ObjNum,0
EndFunction