Text Calendar, International

Windows specific questions.
Post Reply
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Text Calendar, International

Post by Zippy »

Calendar Bytes..

I've again (again reinventing the wheel) coded a unix-like "cal" program, this time using fb. Then/later I was asked if I could "internationalize" my code; my response was somewhat more severe than "NO". Below is a qualified "Yes" (proof code), after some thought;

Code: Select all

'printcal, intl - tested using fb v0.15 on XP
option explicit
#include once "windows.bi"
#include once "win\winnls.bi"
declare function printcal(ds as string) as integer
dim dserial as integer
'
'dserial=printcal("01-01-2006")
'dserial=printcal("12-30-1899")
dserial=printcal(date) 'mm-dd-yyyy
'print:print "Serial Date: ";dserial
sleep
'
function printcal(ds as string) as integer
    dim as string  dstr,fstr,t
    dim as integer dow,sdow,ds1,ds2,ndays,res
    dim as integer y,yy,m,mm,d,dd,a,c,tds,std
    dim stime as SYSTEMTIME
'    
    y=val(right(ds,4)) 'should be >1582
    m=val(left(ds,2))
    d=val(mid(ds,4,2))
    yy=y:mm=m:dd=d
'
    if m<3 then m+=12:y-=1:end if
    dow=(2+d+(13*m-2)\5+y+y\4-y\100+y\400) mod 7
    tds=(d+(153*m-2)\5+365*y+y\4-y\100+y\400)
    printcal = tds-693991 'base = 12-30-1899
'    
    d=1:m=mm:y=yy
    if m<3 then m+=12:y-=1:end if
    ds1=(d+(153*m-2)\5+365*y+y\4-y\100+y\400)
    sdow=(2+d+(13*m-2)\5+y+y\4-y\100+y\400) mod 7
'    
    m=mm:y=yy
    m+=1:if m>12 then m=1:y+=1:end if
    if m<3 then m+=12:y-=1:end if
    ds2=(d+(153*m-2)\5+365*y+y\4-y\100+y\400)
    ndays=ds2-ds1 'if dd>ndays then..bad..day
'
    dstr=space(16)
    GetLocaleInfo(LOCALE_USER_DEFAULT,_     
                  LOCALE_IFIRSTDAYOFWEEK,_
                  strptr(dstr),_
                  len(dstr))
                  
    std=val(dstr) 'LOCALE_IFIRSTDAYOFWEEK, 0=Monday
'
    stime.wYear=yy
    stime.wMonth=mm
    stime.wDay=dd
    dstr=space(256)
10  fstr="MMMM yyyy" & chr(0) 'can reverse "yyyy MMMM"
    dstr=space(256)
    GetDateFormat(LOCALE_USER_DEFAULT,_
	              0,_
                  @stime,_
	              strptr(fstr),_
	              strptr(dstr),_
	              len(dstr))
   
    dstr=trim(dstr)
    print:print space(15-len(dstr)\2);dstr
'
    t="":fstr="ddd" & chr(0)
    stime.wYear=2006
    if std=6 then 
        stime.wMonth=10
    else
        stime.wMonth=5
    endif
    for d=1 to 7                     
        stime.wDay=d
        dstr=space(16)
        GetDateFormat(LOCALE_USER_DEFAULT,_
	                  0,_
                      @stime,_
	                  strptr(fstr),_
	                  strptr(dstr),_
	                  len(dstr))
                      
        dstr=left(trim(dstr),3)
        t = t & dstr & space(4-len(dstr))
    next
    print:print "  ";t
' 
    if std<>6 then
      sdow-=1: if sdow<0 then sdow=6:end if
    end if
    a = 1-sdow:c=0
    while a<=ndays
        if a>=1 then
            color iif(a=dd,15,7),0
            print using "####";a;
        else
            print space(4);
        end if
        a+=1:c+=1
        if c=7 then c=0:print:end if
    wend
'
    stime.wYear=yy
    stime.wMonth=mm
    stime.wDay=dd
    dstr=space(256)
    GetDateFormat(LOCALE_USER_DEFAULT,_
	              DATE_LONGDATE,_
                  @stime,_
	              NULL,_
	              strptr(dstr),_
	              len(dstr))
                  
    dstr=trim(dstr)
    print:print:color 15,0
    print space(15-len(dstr)\2);dstr
    color 7,0
end function

The code should print a localized month calendar to console (which means that it can be cut/pasted, which is the ONLY reason I have for reinventing text calendars). You should see a Monday-start week calendar if your locale specifies this, Sunday-first if not.

So.. Does it work outside of my whitebread Americun world?
dkl
Site Admin
Posts: 3235
Joined: Jul 28, 2005 14:45
Location: Germany

Post by dkl »

I just copy/pasted it and compiled with CVS version, works fine...
Sisophon2001
Posts: 1706
Joined: May 27, 2005 6:34
Location: Cambodia, Thailand, Lao, Ireland etc.
Contact:

Post by Sisophon2001 »

It works on a computer setup with dd/mm/yyyy format.

Garvan
voodooattack
Posts: 605
Joined: Feb 18, 2006 13:30
Location: Alexandria / Egypt
Contact:

Post by voodooattack »

works here, but the arabic letters can't show up inside a console :-/

however, i've managed to get it to support unicode:

Code: Select all

'printcal, intl - tested using fb v0.15 on XP
option explicit

#define UNICODE

#include once "windows.bi"
#include once "win\winnls.bi"
declare function printcal(ds as wstring ptr) as integer
dim dserial as integer
'
'dserial=printcal("01-01-2006")
'dserial=printcal("12-30-1899")
dserial=printcal(wstr(date)) 'mm-dd-yyyy
'print:print "Serial Date: ";dserial
sleep
'
function printcal(ds as wstring ptr) as integer
    dim as wstring * 256  dstr,fstr,t
    dim as integer dow,sdow,ds1,ds2,ndays,res
    dim as integer y,yy,m,mm,d,dd,a,c,tds,std
    dim stime as SYSTEMTIME
'   
    y=val(right(*ds,4)) 'should be >1582
    m=val(left(*ds,2))
    d=val(mid(*ds,4,2))
    yy=y:mm=m:dd=d
'
    if m<3 then m+=12:y-=1:end if
    dow=(2+d+(13*m-2)\5+y+y\4-y\100+y\400) mod 7
    tds=(d+(153*m-2)\5+365*y+y\4-y\100+y\400)
    printcal = tds-693991 'base = 12-30-1899
'   
    d=1:m=mm:y=yy
    if m<3 then m+=12:y-=1:end if
    ds1=(d+(153*m-2)\5+365*y+y\4-y\100+y\400)
    sdow=(2+d+(13*m-2)\5+y+y\4-y\100+y\400) mod 7
'   
    m=mm:y=yy
    m+=1:if m>12 then m=1:y+=1:end if
    if m<3 then m+=12:y-=1:end if
    ds2=(d+(153*m-2)\5+365*y+y\4-y\100+y\400)
    ndays=ds2-ds1 'if dd>ndays then..bad..day
'
    dstr=wstr(space(16))
    GetLocaleInfo(LOCALE_USER_DEFAULT,_     
                  LOCALE_IFIRSTDAYOFWEEK,_
                  (dstr),_
                  len(dstr))
                 
    std=val(dstr) 'LOCALE_IFIRSTDAYOFWEEK, 0=Monday
'
    stime.wYear=yy
    stime.wMonth=mm
    stime.wDay=dd
    dstr=wstr(space(256))
10  fstr=wstr("MMMM yyyy") '& chr(0) 'can reverse "yyyy MMMM"
    dstr=wstr(space(256))
    GetDateFormat(LOCALE_USER_DEFAULT,_
                 0,_
                  @stime,_
                 (fstr),_
                 (dstr),_
                 len(dstr))
   
    dstr=trim(dstr)
    print:print space(15-len(dstr)\2);dstr
'
    t="":fstr=wstr("ddd") '& chr(0) & chr(0)
    stime.wYear=2006
    if std=6 then
        stime.wMonth=10
    else
        stime.wMonth=5
    endif
    for d=1 to 7                     
        stime.wDay=d
        dstr=space(16)
        GetDateFormat(LOCALE_USER_DEFAULT,_
                     0,_
                      @stime,_
                     (fstr),_
                     (dstr),_
                     len(dstr))
                     
        dstr=left(trim(dstr),3)
        t = t & dstr & space(4-len(dstr))
    next
    print:print "  ";t
'
    if std<>6 then
      sdow-=1: if sdow<0 then sdow=6:end if
    end if
    a = 1-sdow:c=0
    while a<=ndays
        if a>=1 then
            color iif(a=dd,15,7),0
            print using "####";a;
        else
            print space(4);
        end if
        a+=1:c+=1
        if c=7 then c=0:print:end if
    wend
'
    stime.wYear=yy
    stime.wMonth=mm
    stime.wDay=dd
    dstr=space(256)
    GetDateFormat(LOCALE_USER_DEFAULT,_
                 DATE_LONGDATE,_
                  @stime,_
                 NULL,_
                 (dstr),_
                 sizeof(dstr))
                 
    dstr=trim(dstr)
    print:print:color 15,0
    print space(15-len(dstr)\2);dstr
    color 7,0
end function 
this will show in any language, but only if you switch the console font format from raster to TTF fonts (lucida console) manually..

Image

^^ there's no APIs to do this now, perhaps in the up-coming vista:
http://msdn.microsoft.com/library/defau ... lefont.asp
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

There is no single API function to do it, but it can be done with the current API. Use this at your own risk, and you really should backup your registry before you start playing with it. I always do ;)

Code: Select all

#define unicode
#include once "windows.bi"
#inclib "advapi32"                      ' Not in v0.15b winreg.bi
option explicit

''
'' To make this work I had to modify the v0.15b windef.bi replacing
'' "type HKEY as HKEY__ ptr" with "type HKEY as DWORD".
''

#define HKEY_CURRENT_USER &h80000001

#define NAME_SIZE 1024                  ' Arbitrary generous size.

dim h_key as HKEY
dim cbValueData as uint = NAME_SIZE
dim valueData as wstring * NAME_SIZE
dim val_ent as VALENT
dim as wstring * 10 subKey => "Console"
dim as wstring * 10 faceName => "FaceName"
dim as wstring * NAME_SIZE oldFaceName
dim as wstring * 30 newFaceName => "Lucida Console"

' Open the target registry subkey.
'
if RegOpenKeyEx( HKEY_CURRENT_USER,@subKey,0,KEY_ALL_ACCESS,@h_key ) then
    print "Error opening key, press any key to exit..."
    sleep
    end
endif

' Get and display the FaceName value data.
'
val_ent.ve_valuename = @faceName
val_ent.ve_valuelen =  NAME_SIZE
val_ent.ve_valueptr = cast(DWORD,@valueData)
val_ent.ve_type = REG_SZ
if RegQueryMultipleValues( h_key,@val_ent,1,@valueData,@cbValueData ) then
    print "Error getting current value/data, press any key to exit..."
    sleep
    end
endif
print "FaceName = ";valueData

' And save it.
'
oldFaceName = valueData

' Set the FaceName value data to "Lucida Console".
'
print "Setting FaceName value data to 'Lucida Console'"
if RegSetValueEx( h_key,@faceName,NULL,REG_SZ,cast(BYTE PTR,@newFaceName),32 ) then
    print "Error setting value/data, press any key to exit..."
    sleep
    end
endif

' Pause and then restart the console so the changes will take effect.
'
print "Press any key to restart console..."
sleep
FreeConsole
AllocConsole

' Get and display the FaceName value data.
' (cbValueData must be reset because the
' previous call could have changed it).
cbValueData = NAME_SIZE
val_ent.ve_valuename = @faceName
val_ent.ve_valuelen =  NAME_SIZE
val_ent.ve_valueptr = cast(DWORD,@valueData)
val_ent.ve_type = REG_SZ
if RegQueryMultipleValues( h_key,@val_ent,1,@valueData,@cbValueData ) then
    print "Error getting current value/data, press any key to exit..."
    sleep
    end
endif
print "New FaceName = ";valueData

print "Press any key to restore original..."
sleep

' Restore original FaceName value.
'
if RegSetValueEx( h_key,@faceName,NULL,REG_SZ,cast(BYTE PTR,@oldFaceName),32 ) then
    print "Error setting value/data, press any key to exit..."
    sleep
    end
endif

' Restart the console so the changes will take effect.
'
FreeConsole
AllocConsole
    
print "Press any key to exit..."

sleep
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Post by Zippy »

This is very interesting. Thanks to all for checking.

Note that I'm arbitrarily forcing/truncating the abbreviated daynames to 3 chars. M$ implies that a "ddd" format dayname returned by GetDateFormat will always be 3 chars - wrong, my minimal testing showed a range of 2 (e.g., German) to 4 (don't rem what lang that was, it was 3 chars + period). Later M$ offers a method to get short abbreviated daynames (heh). I don't know (can't understand) what impact my truncation has on Arabic (or???). My original English-only version uses 2 chars, allowing for a more compact (square) calendar.

Note that GetDateFormat will not work for years<1601. The underlying code (modified-modified Zeller) is accurate to 01-01-01 as-is (with exception of the year<1583 11 day Gregorian fudge).

@voodooattack

Your Unicode mod is great. I had considered this but didn't think I'd be able to test it. Wrong, works fine with standard codepage in XP console (and with, for example, an Italian calendar).

@MichaelW

Kewl, reghacks. Beware the faint of heart.

-----

Ok, now I'll try to stuff this back into my "cal" code. Another half-day on the (reinvented) wheel..
voodooattack
Posts: 605
Joined: Feb 18, 2006 13:30
Location: Alexandria / Egypt
Contact:

Post by voodooattack »

well the longest weekday name in arabic is 9 characters.. :)

and we never use "short abbreviated daynames" in arabic ;D
what impact my truncation has on Arabic
ruins it ;)

a good strategy would be enumerating all the daynames, and using the largest width as the column width.. :)

@MichaelW: good work, i knew how to set that via the registery, but i wouldn't do this in a real life product ;)
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Post by Zippy »

voodooattack wrote:well the longest weekday name in arabic is 9 characters.. :)

and we never use "short abbreviated daynames" in arabic ;D
what impact my truncation has on Arabic
ruins it ;)

a good strategy would be enumerating all the daynames, and using the largest width as the column width.. :)

...
Heh. A good strategy is to pander to those who might use my product. And since I'm not selling (a product) .. But your point is valid, even if I stubbornly stick with 3 char daynames. I would think that any presentation of sequential numbers in 7xn format with a discernible monthname header could be interpreted as a calendar, particularly if you are told it is a calendar. Numbers alone should be sufficient. Left to right or right to left?

I didn't have time to fold voodoo's unicode mods into my fb-"cal" code. I did flop this interactive cal together:

Code: Select all

'printcal, intl - tested using fb v0.15 on XP
' unicode @VoodooAttack, modified
option explicit
#define UNICODE
#include once "windows.bi"
#include once "win\winnls.bi"

declare sub printcal()
dim shared as integer y,m,d,ny,nm,nd
dim as string ds,k
dim as integer ty,tm
dim shared as wstring * 256 daystring =""

10  'screenres 248,108,8 'uncomment this and
20  'color 7,0           'this for graphic cal

ds=date
y=val(right(ds,4))
m=val(left(ds,2))
d=val(mid(ds,4,2))
ny=y:nm=m:nd=d

while (1)
    cls
    printcal()
    sleep

    k=ucase(inkey)
    select case k
    case chr(27)
        exit while
    case chr(255) + chr(75)          'left arrow
        m-=1:if m<1 then m=12:y-=1
    case chr(255) + chr(77)          'right arrow
        m+=1:if m>12 then m=1:y+=1
    case chr(255) + chr(72)          'up arrow
        y+=1
    case chr(255) + chr(80)          'down arrow
        y-=1:if y<1601 then y=1601
    case "Y"
        locate 12,1:print space(40);
        locate 12,1
30      print "(";str(y);") Year: ";
        input ty
        if ty>1600 then y=ty
    case "M"
        locate 12,1:print space(40);
        locate 12,1
40      print "(";str(m);") Month: ";
        input tm
        if tm>=1 and tm<=12 then m=tm
    case "N"                         'now
        ds=date
        y=val(right(ds,4))
        m=val(left(ds,2))
        d=val(mid(ds,4,2))
        ny=y:nm=m:nd=d
    end select
    
wend
'
locate csrlin,pos,1:print
end
'
sub printcal()
    dim as wstring * 256  dstr,fstr
    dim as integer dow,sdow,ds1,ds2,ndays
    dim as integer yy,mm,dd,a,c,tds,std
    dim stime as SYSTEMTIME
'
    yy=y:mm=m:dd=d
    if yy=ny and mm=nm then dd=nd
'
    if m<3 then m+=12:y-=1:end if
    dow=(2+d+(13*m-2)\5+y+y\4-y\100+y\400) mod 7
'    
    d=1:m=mm:y=yy
    if m<3 then m+=12:y-=1:end if
    ds1=(d+(153*m-2)\5+365*y+y\4-y\100+y\400)
    sdow=(2+d+(13*m-2)\5+y+y\4-y\100+y\400) mod 7
'    
    m=mm:y=yy
    m+=1:if m>12 then m=1:y+=1:end if
    if m<3 then m+=12:y-=1:end if
    ds2=(d+(153*m-2)\5+365*y+y\4-y\100+y\400)
    ndays=ds2-ds1
    if dd>ndays then dd=ndays
'
    dstr=wstr(space(16))
    GetLocaleInfo(LOCALE_USER_DEFAULT,_     
                  LOCALE_IFIRSTDAYOFWEEK,_
                  (dstr),_
                  sizeof(dstr))
                  
    std=val(dstr) 'LOCALE_IFIRSTDAYOFWEEK, 0=Monday
'
    stime.wYear=yy 
    stime.wMonth=mm 
    stime.wDay=dd 
50  fstr=wstr("MMMM yyyy") 'can reverse "yyyy MMMM" 
    dstr=wstr(space(256)) 
    GetDateFormat(LOCALE_USER_DEFAULT,_ 
                 0,_ 
                  @stime,_ 
                 (fstr),_ 
                 (dstr),_ 
                 sizeof(dstr)) 
    
    dstr=trim(dstr)
    windowtitle dstr
    color 15,0
    print:print space(15-len(dstr)\2);dstr 
    color 7,0
'
if daystring="" then
    fstr=wstr("ddd")
    stime.wYear=2006
    if std=6 then 
        stime.wMonth=10
    else
        stime.wMonth=5
    endif
    for d=1 to 7                     
        stime.wDay=d
        dstr=wstr(space(16))
        GetDateFormat(LOCALE_USER_DEFAULT,_
	                  0,_
                      @stime,_
	                  (fstr),_
	                  (dstr),_
	                  sizeof(dstr))
                      
        dstr=left(trim(dstr),3)
        daystring = daystring & dstr & space(4-len(dstr))
    next
end if
    print:print "  ";daystring
' 
    if std<>6 then
      sdow-=1: if sdow<0 then sdow=6:end if
    end if
    a = 1-sdow:c=0
    while a<=ndays
        if a>=1 then
            if yy=ny and mm=nm then
                color iif(a=dd,15,7),0
            end if
            print using "####";a;
        else
            print space(4);
        end if
        a+=1:c+=1
        if c=7 then c=0:print:end if
    wend
'
if yy=ny and mm=nm and dd=nd then
    stime.wYear=yy
    stime.wMonth=mm
    stime.wDay=dd
    dstr=wstr(space(256))
    GetDateFormat(LOCALE_USER_DEFAULT,_
	              DATE_LONGDATE,_
                  @stime,_
	              NULL,_
	              (dstr),_
	              sizeof(dstr))
                  
    dstr=trim(dstr)
    locate 12,1,0 : color 15,0
    print space(15-len(dstr)\2);dstr;
    color 7,0
end if
    y=yy:m=mm:d=dd
end sub

Unicode again thanks to voodooattack.
voodooattack
Posts: 605
Joined: Feb 18, 2006 13:30
Location: Alexandria / Egypt
Contact:

Post by voodooattack »

np :)

works ok here :D

i tried to add the dynamic col width thing, but its really kinda buggy to do :D
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Post by Zippy »

@voodooattack:

This hack is just for you.. It allows for and formats variable length abbreviated daynames (whatever M$ returns - don't be complaining to me 'bout what Bill does or doesn't do).

How's this?

Code: Select all

           May 2006

Monday     1   8  15  22  29
Tuesday    2   9  16  23  30
Wednesday  3  10  17  24  31
Thursday   4  11  18  25
Friday     5  12  19  26
Saturday   6  13  20  27
Sunday     7  14  21  28

     Wednesday, May 31, 2006

Just kidding..

change this near file line #9 in the interactive calendar above:

Code: Select all

dim shared as integer y,m,d,ny,nm,nd

to this (adding maxlen globally):

Code: Select all

dim shared as integer y,m,d,ny,nm,nd,maxlen

Replace file lines #115-155 (? check this, I may have changed something else) with this:

Code: Select all

if daystring="" then
    dim da(7) as wstring * 16
    dim as integer res
    maxlen=0
    fstr=wstr("ddd")
    stime.wYear=2006
    if std=6 then 
        stime.wMonth=10
    else
        stime.wMonth=5
    endif
    for d=1 to 7                     
        stime.wDay=d
        dstr=wstr(space(16))
        res=GetDateFormat(LOCALE_USER_DEFAULT,_
	                  0,_
                          @stime,_
	                  (fstr),_
	                  (dstr),_
	                  sizeof(dstr))
                      
        dstr=trim(dstr)
        if len(dstr)>maxlen then maxlen=len(dstr)
        da(d)=dstr
    next
    maxlen+=1
    dim ts as wstring * 32
    for d=1 to 7
        ts=wstr(space(maxlen-len(da(d)))) & da(d)
        daystring=daystring & ts
    next
    daystring=ltrim(daystring)
end if
    print:print "  ";daystring
' 
    if std<>6 then
      sdow-=1: if sdow<0 then sdow=6:end if
    end if
    a = 1-sdow:c=0
    while a<=ndays
        if a>=1 then
            if yy=ny and mm=nm then
                color iif(a=dd,15,7),0
            end if
            print space(maxlen-len(str(a)));str(a);
        else
            print space(maxlen);
        end if
        a+=1:c+=1
        if c=7 then c=0:print:end if
    wend
'

The only language I can find installed on (my) XP to test that returns variable length abbreviated daynames is Sami, Northern [Finland]:

Code: Select all


       miessemánnu 2006

  vuos ma?  gask duor bear láv  sotn
    1    2    3    4    5    6    7
    8    9   10   11   12   13   14
   15   16   17   18   19   20   21
   22   23   24   25   26   27   28
   29   30   31


    miessemánu 31. b. 2006

I'll leave the formatting (placement) of the month/year header and longdate (footer) to you..

Code: Select all

If you MUST have full daynames add another "d":
-->fstr=wstr("dddd")
reverse the spacing:
-->ts=wstr(space(maxlen-len(da(d)))) & da(d)
and then comment:
-->'    daystring=ltrim(daystring)
and you'll have a really LONG calendar that will probably wrap the console..

A side note: I caused the abbreviated daystring creation to occur only once (in the original interactive cal), not for efficiency but because it (GetDateFormat) would explode on the 35th call (* 7 days), then segmentation fault on the 36th. Consistently. I'm hoping the other calls don't follow this pattern.. I've leaned on right-arrow to year 2100 without explosions..

Enough. Stick a fork in me, I'm done.
voodooattack
Posts: 605
Joined: Feb 18, 2006 13:30
Location: Alexandria / Egypt
Contact:

Post by voodooattack »

works ok, but unfortunately, the arabic characters are called complex script because the number of characters can be more/less than the length of the actual string displayed xD

for instance, some arabic characters wrap around each other, some characters are only used for formatting (they appear above the text it self) and some others are for spacing :)

so i guess m$ made it impossible with fixed-width fonts ;D

thanks anyway, at least i discovered something new to play with :)
Post Reply