home *** CD-ROM | disk | FTP | other *** search
- /***********************************************************************
- $DAT >>SaveWork.clssa<< 20 Nov 1992 - (C) ProDAD Holger Burkarth
- ************************************************************************/
-
- OPTIONS RESULTS
- PARSE ARG filename
-
- GetPref
- IF FIND(RESULT,"LaceCompensation")>0 THEN PV=1
- ELSE PV=0
-
- FailAt 20
- AltFail=RESULT
- DO FOREVER
-
- IF filename="" THEN DO
- FileSelect "TITLE 'Save Work Data' PTEXT 'Save'"
- filename=RESULT
- END
- IF filename="" THEN LEAVE
- SelectAnim
- SelectedAnim=RESULT
-
- IF Open(saveit, filename, 'Write') THEN DO
- CALL Writeln(saveit,"clariSSA-SaveWork")
-
- ret=SaveAnimLayOut("MASTER")
- if ret~="" THEN CALL Writeln(saveit,ret)
- ret=SaveAnimLayOut("SOURCE_A")
- if ret~="" THEN CALL Writeln(saveit,ret)
- ret=SaveAnimLayOut("SOURCE_B")
- if ret~="" THEN CALL Writeln(saveit,ret)
- ret=SaveAnimLayOut("SOURCE_C")
- if ret~="" THEN CALL Writeln(saveit,ret)
- ret=SaveAnimLayOut("SOURCE_D")
- if ret~="" THEN CALL Writeln(saveit,ret)
-
- GetPlayMode
- String="FLAGS PLAYMODE "RESULT
- GetEditMode
- String=String" EDITMODE "RESULT
- GetPref
- String=String" PREF "RESULT
- HelpRequester
- String=String" HELP "RESULT
- GetScreenGrabber
- String=String" SGBB "RESULT
- CALL Writeln(saveit,String)
-
- IF PV=1 THEN DO
- String="PV "
- GetUserWork
- String=String" USERWORK "RESULT
- CALL Writeln(saveit,String)
-
-
-
- ret=SaveMonOutLayOut("EDIT")
- if ret~="" THEN CALL Writeln(saveit,ret)
- ret=SaveMonOutLayOut("PROFILE")
- if ret~="" THEN CALL Writeln(saveit,ret)
- END
-
- CALL Close(saveit)
- END; ELSE Message "'Work Data cannot''be saved.'"
-
- SelectAnim SelectedAnim
-
- LEAVE
- END
- FailAt AltFail
- RETURN
-
-
-
-
- SaveAnimLayOut: procedure
- DO
- ARG Anim
-
- ret=""
- SelectAnim Anim
- GetAnimInfo Anim
- IF RESULT~="" THEN DO
- PARSE VAR RESULT "'" AnimFile "' ID" AnimID . "POS" AnimPos .
- IF AnimFile~="" THEN DO
- ret='ANIMATION 'Anim' "'AnimFile'" POS 'AnimPos
- GetArea
- ret=ret" AREA "RESULT
- END
- END
- RETURN (ret)
- END
-
-
- SaveMonOutLayOut: procedure
- DO
- ARG Monitor
-
- MonitorWindow Monitor
- ret="MONITOROUT "RESULT
- RETURN (ret)
- END
-